# HG changeset patch # User Steve Losh # Date 1448910376 0 # Node ID 8ead66c5c0fb37a87da8ed3a89aaaba59dd88812 # Parent 9038eaf084b98977259107c13877071fbca3d411 Add Fireplace workarounds. In related news: God is dead. diff -r 9038eaf084b9 -r 8ead66c5c0fb nrepl.lisp --- a/nrepl.lisp Wed Sep 23 15:45:23 2015 +0000 +++ b/nrepl.lisp Mon Nov 30 19:06:16 2015 +0000 @@ -6,6 +6,7 @@ (ql:quickload "bordeaux-threads") (ql:quickload "uuid") (ql:quickload "fset") +(ql:quickload "cl-ppcre") (require 'sb-introspect) @@ -59,6 +60,10 @@ remaining))))) (build m keyvals))) +(defun with-map (m key f) + (let ((val (fset:lookup m key))) + (fset:with m key (funcall f val)))) + (defmethod print-object ((object hash-table) stream) (format stream "#HASH{~{~{(~a : ~a)~}~^ ~}}" (loop for key being the hash-keys of object @@ -88,9 +93,15 @@ (loop for key being the hash-keys of h collect key)) +(defun starts-with (prefix str) + (string= str prefix :end1 (length prefix))) + (defun l (&rest args) (apply #'format *log* args)) +(defun p (&rest args) + (apply #'format *log* "~a~%" args)) + ;;;; Sockets ------------------------------------------------------------------ (defun get-stream (sock) @@ -121,6 +132,93 @@ (defmethod bencode:encode ((fb fset:bag) stream &key &allow-other-keys) (bencode:encode (fset:convert 'list fb) stream)) +(defmethod bencode:encode ((fb fset:seq) stream &key &allow-other-keys) + (bencode:encode (fset:convert 'list fb) stream)) + + +;;;; Workarounds -------------------------------------------------------------- +;;; welcome to the jungle +;;; we've got hacks and strings +;;; you can get anything you want +;;; but it better be hacks or strings + +; (import traceback) + +(defun workaround-matches (l code) + (equal (apply #'concatenate 'string l) + code)) + +(defmacro handle-workaround (message fallback op check &rest body) + `(if (and (equal ,op (fset:lookup ,message "op")) + (,@check (fset:lookup ,message "code"))) + (progn + ,@body + (respond ,message (make-map "status" '("done")))) + (funcall ,fallback ,message))) + +(defun workaround-fireplace-classpath (h) + (lambda (message) + (handle-workaround + message h "eval" + (workaround-matches + '("(do (println \"success\") " + "(symbol (str (System/getProperty \"path.separator\") " + "(System/getProperty \"java.class.path\"))))")) + (respond message (make-map "value" ":"))))) + +(defun workaround-fireplace-pathsep (h) + (lambda (message) + (handle-workaround + message h "eval" + (workaround-matches + '("[(System/getProperty \"path.separator\") " + "(System/getProperty \"java.class.path\")]")) + (respond message (make-map "value" '("/" ":")))))) + +(defun workaround-fireplace-star (h) + (lambda (message) + (handle-workaround + message h "eval" + ((lambda (code) + (member code '("(*1 1)" "(*2 2)" "(*3 3)") :test #'equal))) + (respond message (make-map "value" "Not yet implemented, sorry :("))))) + +(defun workaround-fireplace-fakepathsep (h) + ; lol what in the fuck even is this for? + (lambda (message) + (handle-workaround + message h "eval" + (workaround-matches + '("[(System/getProperty \"path.separator\") " + "(System/getProperty \"fake.class.path\")]")) + (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 + (lambda (message) + (handle-workaround + message h "eval" + (starts-with "(clojure.walk/macroexpand-all (quote") + (funcall h (with-map message "code" + (lambda (s) + (ppcre:regex-replace + "clojure.walk/macroexpand-all" + s + "macroexpand"))))))) + +; (def-workaround (+ "[(symbol (str \"\\n\\b\" (apply str (interleave " +; "(repeat \"\\n\") (map str (.getStackTrace *e)))) " +; "\"\\n\\b\\n\")) *3 *2 *1]") +; [session msg] +; (let [items []] +; (with [session.lock] +; (for [i (traceback.extract-tb session.last-traceback)] +; (.append items (.format "{}({}:{})" +; (get i 2) +; (first i) +; (second i))))) +; (+ "(quote " "[\n\b\n" (.join "\n" items) "\n\b\n nil nil nil]" ")"))) + ;;;; NREPL -------------------------------------------------------------------- ;;; Utils @@ -185,7 +283,7 @@ (handle-op message "ls-sessions" h (respond message - (make-map "status" "done" + (make-map "status" '("done") "sessions" (get-sessions)))))) (defun wrap-session-close (h) @@ -193,7 +291,7 @@ (handle-op message "close" h (remove-session! (fset:lookup message "session")) - (respond message (make-map "status" "session-closed"))))) + (respond message (make-map "status" '("session-closed")))))) ;;; Eval @@ -203,7 +301,7 @@ (standard-error :initarg :err :reader err))) (defun handle-base (message) - (respond message (make-map "status" "unknown-op"))) + (respond message (make-map "status" '("unknown-op")))) (defun shuttle-stream (from-stream stream-name message) @@ -214,7 +312,7 @@ (equal data "")) nil) (when (not (equal data "")) - (respond message (make-map "status" "ok" + (respond message (make-map "status" '("ok") stream-name data))) (sleep 0.1))) @@ -242,7 +340,7 @@ (respond message (make-map "form" (prin1-to-string form) "value" result)))) - (respond message (make-map "status" "done"))) + (respond message (make-map "status" '("done")))) (close captured-out) (close captured-err)))))) @@ -269,14 +367,15 @@ message "documentation" h (let* ((s (find-symbol-harder (fset:lookup message "symbol")))) (respond message - (with-when (make-map "status" "done") - "type-docstring" (documentation s 'type) - "structure-docstring" (documentation s 'structure) - "variable-docstring" (documentation s 'variable) - "setf-docstring" (documentation s 'setf) - "function-docstring" (documentation s 'function) - "function-arglist" (when-let ((arglist (find-lambda-list s))) - (prin1-to-string arglist)))))))) + (with-when + (make-map "status" '("done")) + "type-docstring" (documentation s 'type) + "structure-docstring" (documentation s 'structure) + "variable-docstring" (documentation s 'variable) + "setf-docstring" (documentation s 'setf) + "function-docstring" (documentation s 'function) + "function-arglist" (when-let ((arglist (find-lambda-list s))) + (prin1-to-string arglist)))))))) ;;; Plumbing @@ -287,13 +386,18 @@ NREPL development its_fine. " - (reverse - (list - #'wrap-session - #'wrap-session-ls - #'wrap-session-close - #'wrap-eval - #'wrap-documentation))) + (list + #'wrap-session + #'wrap-session-ls + #'wrap-session-close + ; just kill me please + #'workaround-fireplace-classpath + #'workaround-fireplace-pathsep + #'workaround-fireplace-star + #'workaround-fireplace-fakepathsep + #'workaround-fireplace-macroexpand-all + #'wrap-eval + #'wrap-documentation)) (defun build-handler (base middleware) "Collapse the stack of middleware into a single handler function." @@ -304,7 +408,7 @@ (defun handle (message) "Handle the given NREPL message." - (l "Handling message:~%~A~%~%" message) + (l "Handling message: vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv~%~A~%^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^~%" message) (funcall (build-handler #'handle-base (middleware)) message)) (defun handle-message (socket lock) @@ -354,14 +458,12 @@ ;;;; Scratch ------------------------------------------------------------------ (comment - (connect) (handle-message) (start-server "localhost" 8675) (stop-server)) ; TODO -; * Convert to fset ; * Implement middleware metadata ; * Implement middleware linearization ; * Implement sessions diff -r 9038eaf084b9 -r 8ead66c5c0fb sender.py --- a/sender.py Wed Sep 23 15:45:23 2015 +0000 +++ b/sender.py Mon Nov 30 19:06:16 2015 +0000 @@ -69,6 +69,9 @@ while True: data = raw_input("> ") if data.strip(): + if data == 'quit': + return + if data.startswith('\\d'): sock.send(bencode.bencode(build_doc(data[2:]))) elif data.startswith('\\'):