# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1442602946 0
# Node ID 090434678b848186391067fb0febcdcf60374627
# Parent  549e41a9283929d5fdcca3e7d0c1a08d87ce27b9
More random work

diff -r 549e41a92839 -r 090434678b84 nrepl.lisp
--- a/nrepl.lisp	Wed Sep 16 20:46:36 2015 +0000
+++ b/nrepl.lisp	Fri Sep 18 19:02:26 2015 +0000
@@ -5,6 +5,12 @@
 (ql:quickload "flexi-streams")
 (ql:quickload "bordeaux-threads")
 
+(require 'sb-introspect)
+
+
+;;;; Variables ----------------------------------------------------------------
+(defvar *server-thread* nil)
+
 
 ;;;; Utilities ----------------------------------------------------------------
 (defun make-hash (&rest keyvals)
@@ -13,17 +19,44 @@
     ((not kvs) h)
     (setf (gethash (first kvs) h) (second kvs))))
 
+(defmacro when-let (bindings &rest body)
+  (labels ((build (bindings body)
+             (if (not bindings)
+               body
+               `(let ((,(caar bindings) ,(cadar bindings)))
+                  (when ,(caar bindings)
+                    ,(build (cdr bindings) body))))))
+    (build bindings `(progn ,@body))))
+
+(defun set-when (h &rest keyvals)
+  (loop for (key val) on keyvals by #'cddr
+        do (when val (setf (gethash key h) val))))
+
 (defmethod print-object ((object hash-table) stream)
   (format stream "#HASH{~{~{(~a : ~a)~}~^ ~}}"
           (loop for key being the hash-keys of object
                 using (hash-value value)
                 collect (list key value))))
 
+(defun read-all-from-string (s)
+  (labels ((read-next-from-string (s results)
+             (if (equal (string-trim " " s) "")
+               results
+               (multiple-value-bind (i pos) (read-from-string s)
+                 (read-next-from-string (subseq s pos) (cons i results))))))
+    (nreverse (read-next-from-string s ()))))
+
+(defmacro comment (&rest body)
+  (declare (ignore body))
+  nil)
+
+
+(defun curry (fn &rest curried-args)
+  (lambda (&rest args)
+    (apply fn (append curried-args args))))
+
 
 ;;;; Sockets ------------------------------------------------------------------
-(defvar *server-thread* nil)
-(defvar *socket* nil)
-
 (defun get-stream (sock)
   "Make a flexi stream of the kind bencode wants from the socket."
   (flex:make-flexi-stream
@@ -31,19 +64,142 @@
     :external-format :utf-8))
 
 
+(defun write-object (socket lock o)
+  "Write an object O (bencoded) to SOCKET while holding LOCK."
+  (bt:with-lock-held (lock)
+                     (bencode:encode o (get-stream socket))
+                     (force-output (get-stream socket))))
+
+(defun read-object (socket)
+  "Read an object (and bdecode it) from *socket*."
+  (bencode:decode (get-stream socket)))
+
+
+;;;; NREPL --------------------------------------------------------------------
+;;; Utils
+(defun respond (message response)
+  (funcall (gethash "transport" message) response))
+
+(defmacro handle-op (message op fallback &rest body)
+  `(if (equal ,op (gethash "op" ,message))
+     (progn ,@body)
+     (funcall ,fallback ,message)))
+
+
+;;; Sessions
+;;; Eval
+
+;;; Handlers and Middleware
+(defun handle-base (message)
+  (respond message (make-hash "status" "unknown-op")))
+
+
+
+
+(defun shuttle-stream (from-stream stream-name message)
+  (do ((data "" (flex:octets-to-string
+                  (flex:get-output-stream-sequence from-stream)
+                  :external-format :utf-8)))
+    ((and (not (open-stream-p from-stream))
+          (equal data ""))
+     nil)
+    (when (not (equal data ""))
+      (respond message (make-hash "status" "ok"
+                                  stream-name data)))
+    (sleep 0.1)))
+
+(defun wrap-eval (h)
+  (lambda (message)
+    (handle-op
+      message "eval" h
+      (let* ((code (gethash "code" message))
+             (captured-out (flex:make-in-memory-output-stream))
+             (captured-err (flex:make-in-memory-output-stream))
+             (*standard-output*
+               (flex:make-flexi-stream captured-out
+                                       :external-format :utf-8)))
+        (unwind-protect
+          (progn
+            (bt:make-thread
+              (lambda () (shuttle-stream captured-out "stdout" message))
+              :name "NREPL stdout writer")
+            (loop for form in (read-all-from-string code)
+                  do (let ((result (prin1-to-string (eval form))))
+                       (respond message
+                                (make-hash "status" "done"
+                                           "form" (prin1-to-string form)
+                                           "value" result)))))
+          (close captured-out)
+          (close captured-err))))))
+
+
+
+
+(defun find-lambda-list (s)
+  (when (fboundp s)
+    (sb-introspect:function-lambda-list s)))
+
+(defun wrap-documentation (h)
+  (lambda (message)
+    (handle-op
+      message "documentation" h
+      (let* ((s (find-symbol (string-upcase (gethash "symbol" message))))
+             (resp (make-hash "status" "done")))
+        (set-when resp
+                  "type-docstring" (documentation s 'type)
+                  "function-docstring" (documentation s 'function)
+                  "function-arglist" (when-let ((arglist (find-lambda-list s)))
+                                       (prin1-to-string arglist)))
+        (respond message resp)))))
+
+
+;;; Plumbing
+(defun middleware ()
+  "Return the stack of middleware.
+
+   In the future we should make this less horrifyingly inefficient, but for
+   NREPL development its_fine.
+
+   "
+  (list
+    #'wrap-eval
+    #'wrap-documentation))
+
+(defun build-handler (base middleware)
+  "Collapse the stack of middleware into a single handler function."
+  (if middleware
+    (funcall (car middleware)
+             (build-handler base (cdr middleware)))
+    base))
+
+(defun handle (message)
+  "Handle the given NREPL message."
+  (format t "Handling message:~%~A~%~%" message)
+  (funcall (build-handler #'handle-base (middleware)) message))
+
+(defun handle-message (socket lock)
+  "Read a single message from the socket and handle it."
+  (let ((message (read-object socket)))
+    (setf (gethash "transport" message)
+          (curry #'write-object socket lock))
+    (handle message)))
+
+(defun handler (socket lock)
+  "Read a series of messages from the socket, handling each."
+  (loop (handle-message socket lock)))
+
+
+;;;; Server -------------------------------------------------------------------
 (defun accept-connections (server-socket)
   "Accept connections to the server and spawn threads to handle each."
   (loop
-    (format t "Waiting for a connection...~%")
-    (let ((client-socket (usocket:socket-accept server-socket
-                                                :element-type '(unsigned-byte 8))))
-      (format t "Connection received.  Spinning up handler thread...~%")
+    (let ((client-socket (usocket:socket-accept
+                           server-socket
+                           :element-type '(unsigned-byte 8)))
+          (write-lock (bt:make-lock "NREPL client writing lock")))
       (bt:make-thread
         (lambda ()
-          (unwind-protect
-            (let ((*socket* client-socket))
-              (handler))
-            (format t "Closing client connection...~%")
+          (unwind-protect (handler client-socket write-lock)
             (usocket:socket-close client-socket)))
         :name "NREPL Connection Handler"))))
 
@@ -51,7 +207,6 @@
   "Fire up a server thread that will listen for connections."
   (format t "Starting server...~%")
   (let ((socket (usocket:socket-listen address port :reuse-address t)))
-    (build-handler)
     (setf *server-thread*
           (bt:make-thread
             (lambda ()
@@ -68,84 +223,12 @@
       (bt:destroy-thread s))))
 
 
-(defun write-object (o)
-  "Write an object (bencoded) to *socket*."
-  (bencode:encode o (get-stream *socket*))
-  (force-output (get-stream *socket*)))
-
-(defun read-object ()
-  "Read an object (and bdecode it) from *socket*."
-  (bencode:decode (get-stream *socket*)))
-
-
-;;;; NREPL --------------------------------------------------------------------
-(defun respond (message response)
-  (funcall (gethash "transport" message) response))
-
-(defmacro handle-op (message op fallback &rest body)
-  `(if (equal ,op (gethash "op" ,message))
-     (progn ,@body)
-     (funcall ,fallback ,message)))
-
-(defun handle-base (message)
-  (respond message (make-hash "status" "unknown-op")))
-
-(defun wrap-time (h)
-  (lambda (message)
-    (format t "In wrap-time...~%")
-    (handle-op
-      message "time?" h
-      (respond message (make-hash "status" "done"
-                                  "time" (get-universal-time))))))
-
-(defun wrap-eval (h)
-  (lambda (message)
-    (format t "In wrap-eval...~%")
-    (handle-op
-      message "eval" h
-      (let ((code (gethash "code" message)))
-        (respond message
-                 (make-hash "status" "done"
-                            "result" (eval (read-from-string code))))))))
-
-(defparameter *middleware*
-  (list
-    #'wrap-eval
-    #'wrap-time))
-
-(defun build-handler (base middleware)
-  (if middleware
-    (funcall (car middleware)
-             (build-handler base (cdr middleware)))
-    base))
-
-(defun handle (message)
-  (format t "Handling message:~%~A~%~%" message)
-  (funcall (build-handler #'handle-base *middleware*) message))
-
-(defun handle-message ()
-  (let ((message (read-object)))
-    (setf (gethash "transport" message) #'write-object)
-    (handle message)))
-
-(defun handler ()
-  (loop (handle-message)))
-
-
 ;;;; Scratch ------------------------------------------------------------------
-; (connect)
-; (handle-message)
-; (start-server "localhost" 8675)
-; (stop-server)
-
-; > (first (list 1 2))
-; Message:
-; 'd2:ns4:user7:session36:37b0fdb1-5d6d-4646-aa68-22af41e172bb5:value1:1e'
-; {'ns': 'user', 'session': '37b0fdb1-5d6d-4646-aa68-22af41e172bb', 'value': '1'}
-; >
-; Message:
-; 'd7:session36:37b0fdb1-5d6d-4646-aa68-22af41e172bb6:statusl4:doneee'
-; {'session': '37b0fdb1-5d6d-4646-aa68-22af41e172bb', 'status': ['done']}
+(comment
+  (connect)
+  (handle-message)
+  (start-server "localhost" 8675)
+  (stop-server))
 
 ; TODO
 ; * Implement middleware metadata
@@ -159,3 +242,13 @@
 ;   * Implement a minimal amount of fireplace workarounds
 ;
 ; * Implement other nrepl default ops
+(comment
+  (defparameter s (flex:make-in-memory-output-stream))
+  (defparameter fs (flex:make-flexi-stream s :external-format :utf-8))
+  (close s)
+  (close fs)
+  (format fs "")
+  (format s "Hello, world!~%")
+  (open-stream-p s)
+  (open-stream-p fs)
+  (flex:octets-to-string (flex:get-output-stream-sequence s) :external-format :utf-8))
diff -r 549e41a92839 -r 090434678b84 sender.py
--- a/sender.py	Wed Sep 16 20:46:36 2015 +0000
+++ b/sender.py	Fri Sep 18 19:02:26 2015 +0000
@@ -1,9 +1,14 @@
+# coding=utf-8
 from __future__ import print_function
 import bencode
 import socket
-import pprint
 import sys
 
+from pygments import highlight
+from pygments.lexers import PythonLexer
+from pygments.formatters import TerminalFormatter
+from pprint import pformat
+
 
 ADDRESS = '127.0.0.1'
 PORT = int(sys.argv[1])
@@ -11,6 +16,51 @@
 def build_eval(data):
     return {"op": "eval", "code": data.strip()}
 
+def build_doc(data):
+    return {"op": "documentation", "symbol": data.strip()}
+
+def pprint(obj):
+    # ...........………………_„-,-~''~''':::'':::':::::''::::''~
+    # ………._,-'':::::::::::::::::::::::::::::::::::::::::::''-„
+    # ………..,-':::::::::::::::::::::::::::::::::::::::::::::::
+    # ………,-'::::::::::::::::::::::::::„:„„-~-~--'~-'~--~-~--~-
+    # ……..,'::::::::::,~'': : : : : : : : : : : : : : : : '-|
+    # ……..|::::::::,-': : : : : : : : - -~''''¯¯''-„: : : : :\
+    # ……..|:::::::: : : : : : : : : _„„--~'''''~-„: : : : '|
+    # ……..'|:::::::,': : : : : : :_„„-: : : : : : : : ~--„_: |'
+    # ………|:::::: : : „--~~'''~~''''''''-„…_..„~''''''''''''¯|
+    # ………|:::::,':_„„-|: : :_„---~: : ''¯¯''''|: ~---„_:   ||
+    # ……..,~-,_/'': : : |: _ o__): : |: :: : : : _o__): \..|
+    # ……../,'-,: : : : : ''-,_______,-'': : : : ''-„_____|
+    # ……..\: : : : : : : : : : : : : : :„: : : : :-,: : :\
+    # ………',:': : : : : : : : : : : : :,-'__: : : :_', ;: ,'
+    # ……….'-,-': : : : : :___„-: : :'': : ¯''~~'': ': : ~--|'
+    # ………….|: ,: : : : : : : : : : : : : : : : : : : :: :
+    # ………….'|: \: : : : : : : : -,„_„„-~~--~--„_: :: : : |
+    # …………..|: \: : : : : : : : : : : :-------~: : : : : |
+    # …………..|: :''-,: : : : : : : : : : : : : : : : : :
+    # …………..',: : :''-, : : : : : : : : : : : :  : :: ,'
+    # ……………| : : : : : : : : :_ : : : : : : : : : : ,-'
+    # ……………|: : : : : : : : : : '''~----------~''
+    # …………._|: : : : : : : : : : : : : : : : : : :
+    # ……….„-''. '-,_: : : : : : : : : : : : : : : : : ,'
+    # ……,-''. . . . . '''~-„_: : : : : : : : : : : : :,-'''-„
+    #              █▀█░█▀█░█▀█░█░█▄░█░▀█▀░
+    #              █▀▀░█▀▀░█▀▄░█░█▀██░░█░░
+    #              ▀░░░▀░░░▀░▀░▀░▀░░▀░░▀░░
+    print(highlight(pformat(obj), PythonLexer(), TerminalFormatter()))
+
+def parse_fucked_bencode_data(data):
+    # im so sorry about this
+    while data:
+        for i in xrange(1, len(data)+1):
+            try:
+                yield bencode.bdecode(data[:i])
+                break
+            except:
+                continue
+        data = data[i:]
+
 def repl():
     sock = socket.socket()
     sock.connect((ADDRESS, PORT))
@@ -19,7 +69,9 @@
     while True:
         data = raw_input("> ")
         if data.strip():
-            if data.startswith('\\'):
+            if data.startswith('\\d'):
+                sock.send(bencode.bencode(build_doc(data[2:])))
+            elif data.startswith('\\'):
                 sock.send(bencode.bencode(eval(data[1:])))
             else:
                 sock.send(bencode.bencode(build_eval(data)))
@@ -27,9 +79,13 @@
         try:
             incoming = sock.recv(4096)
             if incoming:
-                print("Message:")
-                print(repr(incoming))
-                pprint.pprint(bencode.bdecode(incoming))
+                print("Message(s):")
+                print(incoming)
+                try:
+                    pprint(bencode.bdecode(incoming))
+                except bencode.BTL.BTFailure:
+                    for m in parse_fucked_bencode_data(incoming):
+                        pprint(m)
                 print()
         except socket.timeout:
             pass