mirror of
https://github.com/vale981/emacs-ipython-notebook
synced 2025-03-06 01:21:38 -05:00
444 lines
20 KiB
EmacsLisp
444 lines
20 KiB
EmacsLisp
;;; ein-contents-api.el --- Interface to Jupyter's Contents API
|
||
|
||
;; Copyright (C) 2015 - John Miller
|
||
|
||
;; Authors: Takafumi Arakaki <aka.tkf at gmail.com>
|
||
;; John M. Miller <millejoh at mac.com>
|
||
|
||
;; This file is NOT part of GNU Emacs.
|
||
|
||
;; ein-contents-api.el 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.
|
||
|
||
;; ein-contents-api.el 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 ein-notebooklist.el. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
;;;
|
||
;;; An interface to the Jupyter Contents API as described in
|
||
;;; https://github.com/ipython/ipython/wiki/IPEP-27%3A-Contents-Service.
|
||
;;;
|
||
|
||
;;
|
||
|
||
;;; Code:
|
||
|
||
(require 'ein-core)
|
||
(require 'ein-classes)
|
||
(require 'ein-utils)
|
||
(require 'ein-log)
|
||
(require 'ein-query)
|
||
(provide 'ein-notebook) ; see manual "Named Features" regarding recursive requires
|
||
(require 'ein-notebook)
|
||
|
||
(defcustom ein:content-query-max-depth 2
|
||
"Don't recurse the directory tree deeper than this."
|
||
:type 'integer
|
||
:group 'ein)
|
||
|
||
(defcustom ein:content-query-max-branch 6
|
||
"Don't descend into more than this number of directories per depth. The total number of parallel queries should therefore be O({max_branch}^{max_depth})"
|
||
:type 'integer
|
||
:group 'ein)
|
||
|
||
(defcustom ein:content-query-timeout nil ; (* 60 1000) ;1 min
|
||
"Query timeout for getting content from Jupyter/IPython notebook.
|
||
If you cannot open large notebooks because of a timeout error try
|
||
increasing this value. Setting this value to `nil' means to use
|
||
global setting. For global setting and more information, see
|
||
`ein:query-timeout'."
|
||
:type '(choice (integer :tag "Timeout [ms]" 5000)
|
||
(const :tag "Use global setting" nil))
|
||
:group 'ein)
|
||
|
||
(defcustom ein:force-sync nil
|
||
"When non-nil, force synchronous http requests."
|
||
:type 'boolean
|
||
:group 'ein)
|
||
|
||
(defun ein:content-url (content &rest params)
|
||
(apply #'ein:content-url* (ein:$content-url-or-port content) (ein:$content-path content) params))
|
||
|
||
(defun ein:content-url* (url-or-port path &rest params)
|
||
(let* ((which (if (< (ein:notebook-version-numeric url-or-port) 3)
|
||
"notebooks" "contents"))
|
||
(api-path (concat "api/" which)))
|
||
(url-encode-url (apply #'ein:url
|
||
url-or-port
|
||
api-path
|
||
path
|
||
params))))
|
||
|
||
(defun ein:content-query-contents (url-or-port path callback errback &optional iteration)
|
||
"Register CALLBACK of arity 1 for the contents at PATH from the URL-OR-PORT.
|
||
ERRBACK of arity 1 for the contents."
|
||
(unless iteration
|
||
(setq iteration 0))
|
||
(ein:query-singleton-ajax
|
||
(ein:content-url* url-or-port path)
|
||
:type "GET"
|
||
:timeout ein:content-query-timeout
|
||
:parser #'ein:json-read
|
||
:complete (apply-partially #'ein:content-query-contents--complete url-or-port path)
|
||
:success (apply-partially #'ein:content-query-contents--success url-or-port path callback)
|
||
:error (apply-partially #'ein:content-query-contents--error url-or-port path callback errback iteration)))
|
||
|
||
(cl-defun ein:content-query-contents--complete (url-or-port path
|
||
&key data symbol-status response
|
||
&allow-other-keys
|
||
&aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data)))
|
||
(ein:log 'debug "ein:query-contents--complete %s" resp-string))
|
||
|
||
(cl-defun ein:content-query-contents--error (url-or-port path callback errback iteration &key symbol-status response error-thrown data &allow-other-keys)
|
||
(let ((status-code (request-response-status-code response))) ; may be nil!
|
||
(case status-code
|
||
(404 (ein:log 'error "ein:content-query-contents--error %s %s"
|
||
status-code (plist-get data :message))
|
||
(when errback (funcall errback url-or-port status-code)))
|
||
(t (if (< iteration (if noninteractive 6 3))
|
||
(progn
|
||
(ein:log 'verbose "Retry content-query-contents #%s in response to %s" iteration status-code)
|
||
(sleep-for 0 (* (1+ iteration) 500))
|
||
(ein:content-query-contents url-or-port path callback errback (1+ iteration)))
|
||
(let ((notice
|
||
(format "ein:content-query-contents--error %s REQUEST-STATUS %s DATA %s"
|
||
(concat (file-name-as-directory url-or-port) path)
|
||
symbol-status (cdr error-thrown))))
|
||
(if (and (eql status-code 403) noninteractive)
|
||
(progn
|
||
(ein:log 'info notice)
|
||
(when callback
|
||
(funcall callback (ein:new-content url-or-port path data))))
|
||
(ein:log 'error notice)
|
||
(when errback (funcall errback url-or-port status-code)))))))))
|
||
|
||
|
||
;; TODO: This is one place to check for redirects - update the url slot if so.
|
||
;; Will need to pass the response object and check either request-response-history
|
||
;; or request-response-url.
|
||
(cl-defun ein:content-query-contents--success (url-or-port path callback
|
||
&key data symbol-status response
|
||
&allow-other-keys)
|
||
(let (content)
|
||
(if (< (ein:notebook-version-numeric url-or-port) 3)
|
||
(setq content (ein:new-content-legacy url-or-port path data))
|
||
(setq content (ein:new-content url-or-port path data)))
|
||
(aif response
|
||
(setf (ein:$content-url-or-port content) (ein:get-response-redirect it)))
|
||
(when callback
|
||
(funcall callback content))))
|
||
|
||
(defun ein:fix-legacy-content-data (data)
|
||
(if (listp (car data))
|
||
(cl-loop for item in data
|
||
collecting
|
||
(ein:fix-legacy-content-data item))
|
||
(if (string= (plist-get data :path) "")
|
||
(plist-put data :path (plist-get data :name))
|
||
(plist-put data :path (format "%s/%s" (plist-get data :path) (plist-get data :name))))))
|
||
|
||
(defun ein:content-to-json (content)
|
||
(let ((path (if (>= (ein:$content-notebook-version content) 3)
|
||
(ein:$content-path content)
|
||
(substring (ein:$content-path content)
|
||
0
|
||
(or (cl-position ?/ (ein:$content-path content) :from-end t)
|
||
0)))))
|
||
(json-encode `((:type . ,(ein:$content-type content))
|
||
(:name . ,(ein:$content-name content))
|
||
(:path . ,path)
|
||
(:format . ,(or (ein:$content-format content) "json"))
|
||
(:content ,@(ein:$content-raw-content content))))))
|
||
|
||
(defun ein:content-from-notebook (nb)
|
||
(let ((nb-content (ein:notebook-to-json nb)))
|
||
(make-ein:$content :name (ein:$notebook-notebook-name nb)
|
||
:path (ein:$notebook-notebook-path nb)
|
||
:url-or-port (ein:$notebook-url-or-port nb)
|
||
:type "notebook"
|
||
:notebook-version (ein:$notebook-api-version nb)
|
||
:raw-content nb-content)))
|
||
|
||
;;; Managing/listing the content hierarchy
|
||
|
||
(defvar *ein:content-hierarchy* (make-hash-table :test #'equal)
|
||
"Content tree keyed by URL-OR-PORT.")
|
||
|
||
(defun ein:content-need-hierarchy (url-or-port)
|
||
"Callers assume ein:content-query-hierarchy succeeded. If not, nil."
|
||
(aif (gethash url-or-port *ein:content-hierarchy*) it
|
||
(ein:log 'warn "No recorded content hierarchy for %s" url-or-port)
|
||
nil))
|
||
|
||
(defun ein:new-content-legacy (url-or-port path data)
|
||
"Content API in 2.x a bit inconsistent."
|
||
(if (plist-get data :type)
|
||
(ein:new-content url-or-port path data)
|
||
(let ((content (make-ein:$content
|
||
:url-or-port url-or-port
|
||
:notebook-version (ein:notebook-version-numeric url-or-port)
|
||
:path path)))
|
||
(setf (ein:$content-name content) (substring path (or (cl-position ?/ path) 0))
|
||
(ein:$content-path content) path
|
||
(ein:$content-type content) "directory"
|
||
;;(ein:$content-created content) (plist-get data :created)
|
||
;;(ein:$content-last-modified content) (plist-get data :last_modified)
|
||
(ein:$content-format content) nil
|
||
(ein:$content-writable content) nil
|
||
(ein:$content-mimetype content) nil
|
||
(ein:$content-raw-content content) (ein:fix-legacy-content-data data))
|
||
content)))
|
||
|
||
(defun ein:new-content (url-or-port path data)
|
||
;; data is like (:size 72 :content nil :writable t :path Untitled7.ipynb :name Untitled7.ipynb :type notebook)
|
||
(let ((content (make-ein:$content
|
||
:url-or-port url-or-port
|
||
:notebook-version (ein:notebook-version-numeric url-or-port)
|
||
:path path)))
|
||
(setf (ein:$content-name content) (plist-get data :name)
|
||
(ein:$content-path content) (plist-get data :path)
|
||
(ein:$content-type content) (plist-get data :type)
|
||
(ein:$content-created content) (plist-get data :created)
|
||
(ein:$content-last-modified content) (plist-get data :last_modified)
|
||
(ein:$content-format content) (plist-get data :format)
|
||
(ein:$content-writable content) (plist-get data :writable)
|
||
(ein:$content-mimetype content) (plist-get data :mimetype)
|
||
(ein:$content-raw-content content) (plist-get data :content))
|
||
content))
|
||
|
||
(defun ein:content-query-hierarchy* (url-or-port path callback sessions depth content)
|
||
"Returns list (tree) of content objects. CALLBACK accepts tree."
|
||
(lexical-let* ((url-or-port url-or-port)
|
||
(path path)
|
||
(callback callback)
|
||
(items (ein:$content-raw-content content))
|
||
(directories (if (< depth ein:content-query-max-depth)
|
||
(cl-loop for item in items
|
||
with result
|
||
until (>= (length result) ein:content-query-max-branch)
|
||
if (string= "directory" (plist-get item :type))
|
||
collect (ein:new-content url-or-port path item)
|
||
into result
|
||
end
|
||
finally return result)))
|
||
(others (cl-loop for item in items
|
||
with c0
|
||
if (not (string= "directory" (plist-get item :type)))
|
||
do (setf c0 (ein:new-content url-or-port path item))
|
||
(setf (ein:$content-session-p c0)
|
||
(gethash (ein:$content-path c0) sessions))
|
||
and collect c0
|
||
end)))
|
||
(deferred:$
|
||
(apply
|
||
#'deferred:parallel
|
||
(cl-loop for c0 in directories
|
||
collect
|
||
(lexical-let
|
||
((c0 c0)
|
||
(d0 (deferred:new #'identity)))
|
||
(ein:content-query-contents
|
||
url-or-port
|
||
(ein:$content-path c0)
|
||
(apply-partially #'ein:content-query-hierarchy*
|
||
url-or-port
|
||
(ein:$content-path c0)
|
||
(lambda (tree)
|
||
(deferred:callback-post d0 (cons c0 tree)))
|
||
sessions (1+ depth))
|
||
(lambda (&rest _args) (deferred:callback-post d0 (cons c0 nil))))
|
||
d0)))
|
||
(deferred:nextc it
|
||
(lambda (tree)
|
||
(let ((result (append others tree)))
|
||
(when (string= path "")
|
||
(setf (gethash url-or-port *ein:content-hierarchy*) (-flatten result)))
|
||
(funcall callback result)))))))
|
||
|
||
(defun ein:content-query-hierarchy (url-or-port callback)
|
||
"Send for content hierarchy of URL-OR-PORT with CALLBACK arity 1 for content hierarchy"
|
||
(ein:content-query-sessions
|
||
url-or-port
|
||
(apply-partially (lambda (url-or-port* callback* sessions)
|
||
(ein:content-query-contents url-or-port* ""
|
||
(apply-partially #'ein:content-query-hierarchy*
|
||
url-or-port*
|
||
""
|
||
callback* sessions 0)
|
||
(lambda (&rest ignore)
|
||
(when callback* (funcall callback* nil)))))
|
||
url-or-port callback)
|
||
callback))
|
||
|
||
;;; Save Content
|
||
|
||
(defun ein:content-save-legacy (content &optional callback cbargs errcb errcbargs)
|
||
(ein:query-singleton-ajax
|
||
(ein:content-url content)
|
||
:type "PUT"
|
||
:headers '(("Content-Type" . "application/json"))
|
||
:timeout ein:content-query-timeout
|
||
:data (ein:content-to-json content)
|
||
:success (apply-partially #'ein:content-save-success callback cbargs)
|
||
:error (apply-partially #'ein:content-save-error (ein:content-url content) errcb errcbargs)))
|
||
|
||
(defun ein:content-save (content &optional callback cbargs errcb errcbargs)
|
||
(if (>= (ein:$content-notebook-version content) 3)
|
||
(ein:query-singleton-ajax
|
||
(ein:content-url content)
|
||
:type "PUT"
|
||
:headers '(("Content-Type" . "application/json"))
|
||
:timeout ein:content-query-timeout
|
||
:data (encode-coding-string (ein:content-to-json content)
|
||
buffer-file-coding-system)
|
||
:success (apply-partially #'ein:content-save-success callback cbargs)
|
||
:error (apply-partially #'ein:content-save-error
|
||
(ein:content-url content) errcb errcbargs))
|
||
(ein:content-save-legacy content callback cbargs)))
|
||
|
||
(cl-defun ein:content-save-success (callback cbargs &key status response &allow-other-keys)
|
||
;;(ein:log 'verbose "Saving content successful with status %s" status)
|
||
(when callback
|
||
(apply callback cbargs)))
|
||
|
||
(cl-defun ein:content-save-error (url errcb errcbargs &key response data &allow-other-keys)
|
||
(ein:log 'error
|
||
"Content save %s failed %s %s."
|
||
url (request-response-error-thrown response) (plist-get data :message))
|
||
(when errcb
|
||
(apply errcb errcbargs)))
|
||
|
||
|
||
;;; Rename Content
|
||
|
||
|
||
(defun ein:content-legacy-rename (content new-path callback cbargs)
|
||
(let ((path (substring new-path 0 (or (cl-position ?/ new-path :from-end t) 0)))
|
||
(name (substring new-path (or (cl-position ?/ new-path :from-end t) 0))))
|
||
(ein:query-singleton-ajax
|
||
(ein:content-url content)
|
||
:type "PATCH"
|
||
:data (json-encode `((name . ,name)
|
||
(path . ,path)))
|
||
:parser #'ein:json-read
|
||
:success (apply-partially #'update-content-path-legacy content callback cbargs)
|
||
:error (apply-partially #'ein:content-rename-error new-path))))
|
||
|
||
(cl-defun update-content-path-legacy (content callback cbargs &key data &allow-other-keys)
|
||
(setf (ein:$content-path content) (ein:trim-left (format "%s/%s" (plist-get data :path) (plist-get data :name))
|
||
"/")
|
||
(ein:$content-name content) (plist-get data :name)
|
||
(ein:$content-last-modified content) (plist-get data :last_modified))
|
||
(when callback
|
||
(apply callback cbargs)))
|
||
|
||
(defun ein:content-rename (content new-path &optional callback cbargs)
|
||
(if (>= (ein:$content-notebook-version content) 3)
|
||
(ein:query-singleton-ajax
|
||
(ein:content-url content)
|
||
:type "PATCH"
|
||
:data (json-encode `((path . ,new-path)))
|
||
:parser #'ein:json-read
|
||
:success (apply-partially #'update-content-path content callback cbargs)
|
||
:error (apply-partially #'ein:content-rename-error (ein:$content-path content)))
|
||
(ein:content-legacy-rename content new-path callback cbargs)))
|
||
|
||
(defun ein:session-rename (url-or-port session-id new-path)
|
||
(ein:query-singleton-ajax
|
||
(ein:url url-or-port "api/sessions" session-id)
|
||
:type "PATCH"
|
||
:data (json-encode `((path . ,new-path)))
|
||
:complete #'ein:session-rename--complete))
|
||
|
||
(cl-defun ein:session-rename--complete (&key data response symbol-status
|
||
&allow-other-keys
|
||
&aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data)))
|
||
(ein:log 'debug "ein:session-rename--complete %s" resp-string))
|
||
|
||
(cl-defun update-content-path (content callback cbargs &key data &allow-other-keys)
|
||
(setf (ein:$content-path content) (plist-get data :path)
|
||
(ein:$content-name content) (plist-get data :name)
|
||
(ein:$content-last-modified content) (plist-get data :last_modified))
|
||
(when callback
|
||
(apply callback cbargs)))
|
||
|
||
(cl-defun ein:content-rename-error (path &key response data &allow-other-keys)
|
||
(ein:log 'error
|
||
"Renaming content %s failed %s %s."
|
||
path (request-response-error-thrown response) (plist-get data :message)))
|
||
|
||
;;; Sessions
|
||
|
||
(defun ein:content-query-sessions (url-or-port callback errback &optional iteration)
|
||
"Register CALLBACK of arity 1 to retrieve the sessions.
|
||
Call ERRBACK of arity 1 (contents) upon failure."
|
||
(declare (indent defun))
|
||
(unless iteration
|
||
(setq iteration 0))
|
||
(unless callback
|
||
(setq callback #'ignore))
|
||
(unless errback
|
||
(setq errback #'ignore))
|
||
(ein:query-singleton-ajax
|
||
(ein:url url-or-port "api/sessions")
|
||
:type "GET"
|
||
:parser #'ein:json-read
|
||
:complete (apply-partially #'ein:content-query-sessions--complete url-or-port callback)
|
||
:success (apply-partially #'ein:content-query-sessions--success url-or-port callback)
|
||
:error (apply-partially #'ein:content-query-sessions--error url-or-port callback errback iteration)))
|
||
|
||
(cl-defun ein:content-query-sessions--success (url-or-port callback &key data &allow-other-keys)
|
||
(cl-flet ((read-name (nb-json)
|
||
(if (< (ein:notebook-version-numeric url-or-port) 3)
|
||
(if (string= (plist-get nb-json :path) "")
|
||
(plist-get nb-json :name)
|
||
(format "%s/%s" (plist-get nb-json :path) (plist-get nb-json :name)))
|
||
(plist-get nb-json :path))))
|
||
(let ((session-hash (make-hash-table :test 'equal)))
|
||
(dolist (s data (funcall callback session-hash))
|
||
(setf (gethash (read-name (plist-get s :notebook)) session-hash)
|
||
(cons (plist-get s :id) (plist-get s :kernel)))))))
|
||
|
||
(cl-defun ein:content-query-sessions--error (url-or-port callback errback iteration
|
||
&key response error-thrown
|
||
&allow-other-keys)
|
||
(if (< iteration (if noninteractive 6 3))
|
||
(progn
|
||
(ein:log 'verbose "Retry sessions #%s in response to %s" iteration (request-response-status-code response))
|
||
(sleep-for 0 (* (1+ iteration) 500))
|
||
(ein:content-query-sessions url-or-port callback errback (1+ iteration)))
|
||
(ein:log 'error "ein:content-query-sessions--error %s: ERROR %s DATA %s" url-or-port (car error-thrown) (cdr error-thrown))
|
||
(when errback (funcall errback nil))))
|
||
|
||
(cl-defun ein:content-query-sessions--complete (url-or-port callback
|
||
&key data response
|
||
&allow-other-keys
|
||
&aux (resp-string (format "STATUS: %s DATA: %s" (request-response-status-code response) data)))
|
||
(ein:log 'debug "ein:query-sessions--complete %s" resp-string))
|
||
|
||
;;; Uploads
|
||
|
||
|
||
(defun ein:get-local-file (path)
|
||
"If path exists, get contents and try to guess type of file (one of file, notebook, or directory)
|
||
and content format (one of json, text, or base64)."
|
||
(unless (file-readable-p path)
|
||
(error "File %s is not accessible and cannot be uploaded." path))
|
||
(let ((name (file-name-nondirectory path))
|
||
(type (file-name-extension path)))
|
||
(with-temp-buffer
|
||
(insert-file-contents path)
|
||
(cond ((string= type "ipynb")
|
||
(list name "notebook" "json" (buffer-string)))
|
||
((eql buffer-file-coding-system 'no-conversion)
|
||
(list name "file" "base64" (buffer-string)))
|
||
(t (list name "file" "text" (buffer-string)))))))
|
||
|
||
(provide 'ein-contents-api)
|