--- a/nrepl.lisp Mon Nov 30 19:06:16 2015 +0000
+++ b/nrepl.lisp Tue Dec 01 00:43:50 2015 +0000
@@ -94,13 +94,15 @@
collect key))
(defun starts-with (prefix str)
- (string= str prefix :end1 (length prefix)))
+ (string= str prefix :end1 (min (length str)
+ (length prefix))))
(defun l (&rest args)
(apply #'format *log* args))
-(defun p (&rest args)
- (apply #'format *log* "~a~%" args))
+(defun p (o)
+ (format *log* "~a~%" o)
+ o)
;;;; Sockets ------------------------------------------------------------------
@@ -119,7 +121,11 @@
(defun read-object (socket)
"Read a map (and bdecode it) from *socket*."
- (fset:convert 'fset:map (bencode:decode (get-stream socket))))
+ (fset:convert 'fset:map
+ ; fireplace's bencoding is fucked.
+ ; just ignore it its fine
+ (handler-bind ((error #'continue))
+ (bencode:decode (get-stream socket)))))
;;; Patch in support for writing fset data types to bencode
@@ -173,7 +179,7 @@
(workaround-matches
'("[(System/getProperty \"path.separator\") "
"(System/getProperty \"java.class.path\")]"))
- (respond message (make-map "value" '("/" ":"))))))
+ (respond message (make-map "value" "[\"/\" \":\"]")))))
(defun workaround-fireplace-star (h)
(lambda (message)
@@ -191,7 +197,7 @@
(workaround-matches
'("[(System/getProperty \"path.separator\") "
"(System/getProperty \"fake.class.path\")]"))
- (respond message (make-map "value" '("/" "\"None\""))))))
+ (respond message (make-map "value" "[\"/\" \"None\"]")))))
(defun workaround-fireplace-macroexpand-all (h)
; this should really do a macroexpand-all but this'll have to do for now
@@ -199,6 +205,7 @@
(handle-workaround
message h "eval"
(starts-with "(clojure.walk/macroexpand-all (quote")
+ ; TODO: Fix the extra done status message here
(funcall h (with-map message "code"
(lambda (s)
(ppcre:regex-replace
@@ -242,7 +249,7 @@
(setf *sessions* (make-hash-table :test #'equal)))
(defun create-session ()
- (fset:empty-set))
+ (fset:empty-map))
(defun register-session! (id session)
(setf (gethash id *sessions*) session))
@@ -293,6 +300,14 @@
(remove-session! (fset:lookup message "session"))
(respond message (make-map "status" '("session-closed"))))))
+(defun wrap-session-clone (h)
+ (lambda (message)
+ (handle-op
+ message "clone" h
+ (let ((new-id (register-session! (random-uuid)
+ (fset:lookup message "session"))))
+ (respond message (make-map "status" '("done") "new-session" new-id))))))
+
;;; Eval
(defclass evaluator ()
@@ -378,6 +393,72 @@
(prin1-to-string arglist))))))))
+;;; Describe
+(defun make-version-map (major minor incremental)
+ (make-map "major" major
+ "minor" minor
+ "incremental" incremental
+ "version-string" (format nil "~d.~d.~d" major minor incremental)))
+
+(defun wrap-describe (h)
+ (lambda (message)
+ (handle-op
+ message "describe" h
+ (respond message
+ (make-map "status" '("done")
+ "versions" (make-map
+ "lisp" (make-version-map 0 0 0)
+ "cl-nrepl" (make-version-map 0 0 0)
+ ; we're not nrepl but fireplace wants this
+ "nrepl" (make-version-map 0 2 0))
+ "ops" (make-map))))))
+
+; {'aux': {'current-ns': 'user'},
+; 'ops': {'clone': {'doc': 'Clones the current session, returning the ID of the newly-created session.',
+; 'optional': {'session': 'The ID of the session to be cloned; if not provided, a new session with default bindings is created, and mapped to the returned session ID.'},
+; 'requires': {},
+; 'returns': {'new-session': 'The ID of the new session.'}},
+; 'close': {'doc': 'Closes the specified session.',
+; 'optional': {},
+; 'requires': {'session': 'The ID of the session to be closed.'},
+; 'returns': {}},
+; 'describe': {'doc': 'Produce a machine- and human-readable directory and documentation for the operations supported by an nREPL endpoint.',
+; 'optional': {'verbose?': 'Include informational detail for each "op"eration in the return message.'},
+; 'requires': {},
+; 'returns': {'aux': 'Map of auxilliary data contributed by all of the active nREPL middleware via :describe-fn functions in their descriptors.',
+; 'ops': 'Map of "op"erations supported by this nREPL endpoint',
+; 'versions': 'Map containing version maps (like *clojure-version*, e.g. major, minor, incremental, and qualifier keys) for values, component names as keys. Common keys include "nrepl" and "clojure".'}},
+; 'eval': {'doc': 'Evaluates code.',
+; 'optional': {'eval': 'A fully-qualified symbol naming a var whose function value will be used to evaluate [code], instead of `clojure.core/eval` (the default).',
+; 'id': 'An opaque message ID that will be included in responses related to the evaluation, and which may be used to restrict the scope of a later "interrupt" operation.'},
+; 'requires': {'code': 'The code to be evaluated.',
+; 'session': 'The ID of the session within which to evaluate the code.'},
+; 'returns': {'ex': 'The type of exception thrown, if any. If present, then `values` will be absent.',
+; 'ns': '*ns*, after successful evaluation of `code`.',
+; 'root-ex': 'The type of the root exception thrown, if any. If present, then `values` will be absent.',
+; 'values': 'The result of evaluating `code`, often `read`able. This printing is provided by the `pr-values` middleware, and could theoretically be customized. Superseded by `ex` and `root-ex` if an exception occurs during evaluation.'}},
+; 'interrupt': {'doc': 'Attempts to interrupt some code evaluation.',
+; 'optional': {'interrupt-id': 'The opaque message ID sent with the original "eval" request.'},
+; 'requires': {'session': 'The ID of the session used to start the evaluation to be interrupted.'},
+; 'returns': {'status': '\'interrupted\' if an evaluation was identified and interruption will be attempted\n\'session-idle\' if the session is not currently evaluating any code\n\'interrupt-id-mismatch\' if the session is currently evaluating code sent using a different ID than specified by the "interrupt-id" value '}},
+; 'load-file': {'doc': 'Loads a body of code, using supplied path and filename info to set source file and line number metadata. Delegates to underlying "eval" middleware/handler.',
+; 'optional': {'file-name': 'Name of source file, e.g. io.clj',
+; 'file-path': 'Source-path-relative path of the source file, e.g. clojure/java/io.clj'},
+; 'requires': {'file': 'Full contents of a file of code.'},
+; 'returns': {'ex': 'The type of exception thrown, if any. If present, then `values` will be absent.',
+; 'ns': '*ns*, after successful evaluation of `code`.',
+; 'root-ex': 'The type of the root exception thrown, if any. If present, then `values` will be absent.',
+; 'values': 'The result of evaluating `code`, often `read`able. This printing is provided by the `pr-values` middleware, and could theoretically be customized. Superseded by `ex` and `root-ex` if an exception occurs during evaluation.'}},
+; 'ls-sessions': {'doc': 'Lists the IDs of all active sessions.',
+; 'optional': {},
+; 'requires': {},
+; 'returns': {'sessions': 'A list of all available session IDs.'}},
+; 'stdin': {'doc': 'Add content from the value of "stdin" to *in* in the current session.',
+; 'optional': {},
+; 'requires': {'stdin': 'Content to add to *in*.'},
+; 'returns': {'status': 'A status of "need-input" will be sent if a session\'s *in* requires content in order to satisfy an attempted read operation.'}}},
+
+
;;; Plumbing
(defun middleware ()
"Return the stack of middleware.
@@ -389,6 +470,7 @@
(list
#'wrap-session
#'wrap-session-ls
+ #'wrap-session-clone
#'wrap-session-close
; just kill me please
#'workaround-fireplace-classpath
@@ -396,6 +478,7 @@
#'workaround-fireplace-star
#'workaround-fireplace-fakepathsep
#'workaround-fireplace-macroexpand-all
+ #'wrap-describe
#'wrap-eval
#'wrap-documentation))
@@ -419,7 +502,8 @@
(defun handler (socket lock)
"Read a series of messages from the socket, handling each."
- (loop (handle-message socket lock)))
+ (handler-case (loop (handle-message socket lock))
+ (end-of-file () nil)))
;;;; Server -------------------------------------------------------------------