WIP - recording stdout/stdin

also I had to switch to transit, because prn-str didn't work in some edge cases

sidecar/project.clj

@@ -21,5 +21,6 @@
    [digest "1.4.4"]
    [figwheel "0.5.0-2"
     :exclusions [org.clojure/tools.reader]]
-   [hawk "0.2.5"]])
+   [hawk "0.2.5"]
+   [com.cognitect/transit-clj "0.8.285"]])
 

sidecar/src/figwheel_sidecar/components/figwheel_server.clj

@@ -5,17 +5,31 @@
    [figwheel-sidecar.repl-driver :as repl-driver]
 
    [clojure.java.io :as io]
-   [clojure.edn :as edn]
-   
+   [cognitect.transit :as transit]
+
    [clojure.core.async :refer [go-loop <!! <! timeout]]
 
    [compojure.route :as route]
    [compojure.core :refer [routes GET]]
    [ring.util.response :refer [resource-response]]
    [ring.middleware.cors :as cors]
    [org.httpkit.server :refer [run-server with-channel on-close on-receive send! open?]]
-
-   [com.stuartsierra.component :as component]))
+
+   [com.stuartsierra.component :as component])
+  (:import [java.io ByteArrayInputStream ByteArrayOutputStream]))
+
+
+(defn serialize-msg [msg]
+  (let [out (ByteArrayOutputStream. 4096)
+        writer (transit/writer out :json)]
+    (transit/write writer msg)
+    (.toString out)))
+
+(defn unserialize-msg [serialized-msg]
+  {:pre [(string? serialized-msg)]}
+  (let [in (ByteArrayInputStream. (.getBytes serialized-msg "UTF-8"))
+        reader (transit/reader in :json)]
+    (transit/read reader)))
 
 (defprotocol ChannelServer
   (-send-message [this channel-id msg-data callback])
@@ -29,10 +43,10 @@
 
 (defn read-msg [data]
   (try
-    (let [msg (edn/read-string data)]
+    (let [msg (unserialize-msg data)]
       (if (and (map? msg) (:figwheel-event msg)) msg {}))
     (catch Exception e
-      (println "Figwheel: message from client couldn't be read!")
+      (println "Figwheel: message from client couldn't be read!\n" e data)
       {})))
 
 (defn handle-callback-msg [server-state msg]
@@ -51,11 +65,11 @@
         (println "Figwheel: there was a problem running the open file command - " command)))))
 
 (defn handle-repl-eval-msg [server-state msg]
-  (let [{:keys [code input]} msg]
-    (repl-driver/exec-external-command! code input)))
+  (let [{:keys [request-id code input info-method]} msg]
+    (repl-driver/exec-external-command! request-id code input info-method)))
 
 ;; should make this extendable with multi-method
-(defn handle-client-msg [{:keys [browser-callbacks] :as server-state} data]
+(defn handle-client-msg [server-state data]
   (when data
     (let [msg (read-msg data)]
       (case (:figwheel-event msg)
@@ -89,14 +103,14 @@
                      (= desired-build-id (:build-id msg))))
            (<!! (timeout compile-wait-time))
            (when (open? wschannel)
-             (send! wschannel (prn-str msg)))))))
-    
+             (send! wschannel (serialize-msg msg)))))))
+
     (on-close wschannel
               (fn [status]
                 (update-connection-count connection-count desired-build-id dec)
                 (remove-watch file-change-atom watch-key)
                 #_(println "Figwheel: client disconnected " status)))
-    
+
     (on-receive wschannel
                 (fn [data] (handle-client-msg server-state data)))
 
@@ -105,8 +119,9 @@
     (go-loop []
       (<! (timeout 5000))
       (when (open? wschannel)
-        (send! wschannel (prn-str  {:msg-name :ping
-                                    :project-id (:unique-id server-state)}))
+        (let [msg {:msg-name   :ping
+                   :project-id (:unique-id server-state)}]
+          (send! wschannel (serialize-msg msg)))
         (recur)))))
 
 (defn reload-handler [server-state]
@@ -121,7 +136,7 @@
   (try
     (-> (routes
          (GET "/figwheel-ws/:desired-build-id" {params :params} (reload-handler server-state))
-         (GET "/figwheel-ws" {params :params} (reload-handler server-state))       
+         (GET "/figwheel-ws" {params :params} (reload-handler server-state))
          (route/resources "/" {:root http-server-root})
          (or resolved-ring-handler (fn [r] false))
          (GET "/" [] (resource-response "index.html" {:root http-server-root}))
@@ -168,20 +183,20 @@
        {
         ;; seems like this id should be different for every
         ;; server restart thus forcing the client to reload
-        :unique-id (or unique-id (.getCanonicalPath (io/file "."))) 
+        :unique-id (or unique-id (.getCanonicalPath (io/file ".")))
         :http-server-root (or http-server-root "public")
         :server-port (or server-port 3449)
         :server-ip server-ip
         :ring-handler ring-handler
         ;; TODO handle this better
         :resolved-ring-handler (or resolved-ring-handler
                                    (utils/require-resolve-handler ring-handler))
-        
+
         :open-file-command open-file-command
         :compile-wait-time (or compile-wait-time 10)
-        
+
         :file-md5-atom (atom {})
-        
+
         :file-change-atom (atom (list))
         :browser-callbacks (atom {})
         :connection-count (atom {})
@@ -264,10 +279,10 @@
 (defn figwheel-server [{:keys [figwheel-options all-builds] :as options}]
   (let [all-builds          (map config/add-compiler-env (config/prep-builds all-builds))
         all-builds (ensure-array-map all-builds)
-        
+
         initial-state       (create-initial-state figwheel-options)
         figwheel-opts (assoc initial-state
-                             :builds all-builds       
+                             :builds all-builds
                              :log-writer    (extract-log-writer figwheel-options)
                              :cljs-build-fn (extract-cljs-build-fn figwheel-options))]
     (map->FigwheelServer figwheel-opts)))

sidecar/src/figwheel_sidecar/repl.clj

@@ -7,10 +7,12 @@
    [clojure.java.io :as io]
    [clojure.string :as string]
    [clojure.core.async :refer [chan <!! <! >!! put! alts!! timeout close! go go-loop]]
+   [cognitect.transit :as transit]
 
    [clojure.tools.nrepl.middleware.interruptible-eval :as nrepl-eval]
    [figwheel-sidecar.components.figwheel-server :as server]
    [figwheel-sidecar.repl-driver :as repl-driver]
+   [figwheel-sidecar.writer-proxy :as writer-proxy]
 
    [figwheel-sidecar.config :as config]))
 
@@ -43,6 +45,12 @@
          :value "Eval timed out!"
          :stacktrace "No stacktrace available."}))))
 
+(defn exec-js [figwheel-server js]
+  (server/send-message figwheel-server
+                       (:build-id figwheel-server)
+                       {:msg-name :exec-js
+                        :code     js}))
+
 (defn connection-available?
   [figwheel-server build-id]
   (let [connection-count (server/connection-data figwheel-server)]
@@ -161,11 +169,16 @@
          figwheel-repl-env (repl-env figwheel-server build)
          repl-opts (assoc opts
                      :compiler-env (:compiler-env build)
-                     :read (repl-driver/custom-read-fn-factory build))
+                     :read (repl-driver/multiplexing-reader-factory build)
+                     ;:print (repl-driver/print-recorder-factory build (partial exec-js figwheel-server))
+                     :eval (repl-driver/signalling-eval-cljs build))
          protocol (if (in-nrepl-env?)
                     :nrepl
-                    :default)]
-     (start-cljs-repl protocol figwheel-repl-env repl-opts))))
+                    :default)
+         exec-js-fn (partial exec-js figwheel-server)
+         out-proxy (writer-proxy/make-proxy-writer *out* (partial repl-driver/out-flush-handler exec-js-fn))]
+     (binding [*out* out-proxy]
+       (start-cljs-repl protocol figwheel-repl-env repl-opts)))))
 
 ;; deprecated 
 (defn get-project-cljs-builds []

sidecar/src/figwheel_sidecar/repl_driver.clj

@@ -3,26 +3,112 @@
     [clojure.core.async :refer [chan <!! <! >!! put! alts!! timeout close! go go-loop]]
     [cljs.repl :as cljs-repl]
     [clojure.tools.reader :as reader]
-    [clojure.tools.reader.reader-types :as reader-types]))
+    [clojure.tools.reader.reader-types :as reader-types]
+    [clojure.string :as string])
+  (:import (java.io StringWriter OutputStreamWriter)))
 
 (def repl-commands-channel (chan))
+(def print-recording (volatile! nil))
+(def active-repl-opts (volatile! nil))
+(def ignore-next-print (volatile! false))
+
+(defn resolve-repl-opts []
+  (if-let [opts (resolve 'cljs.repl/*repl-opts*)]
+    @opts))
+
+; cljs.repl/eval-cljs is private, this is a hack around it
+(defn resolve-eval-cljs []
+  (if-let [eval-cljs-var (resolve 'cljs.repl/eval-cljs)]
+    @eval-cljs-var))
+
+; here we mimic code in cljs.repl/repl*
+(defn current-repl-special-fns []
+  (let [special-fns (:special-fns @active-repl-opts)]
+    (merge cljs-repl/default-special-fns special-fns)))
+
+; here we mimic read-eval-print's behaviour in cljs.repl/repl*
+(defn is-special-fn-call-form? [form]
+  (let [is-special-fn? (set (keys (current-repl-special-fns)))]
+    (and (seq? form) (is-special-fn? (first form)))))
 
 ; here we mimic parsing behaviour of cljs.repl/repl-read
-(defn read-external-input [input]
+(defn read-input [input]
   (let [rdr (reader-types/string-push-back-reader input)]
     (cljs-repl/skip-whitespace rdr)
     (reader/read {:read-cond :allow :features #{:cljs}} rdr)))
 
-(defn exec-external-command! [code input]
+(defn is-special-fn-call? [input-text]
+  (is-special-fn-call-form? (read-input input-text)))
+
+(defn exec-external-command! [request-id code input info-method]
   ; first, we echo user's input into stdout
   (println input)
+
   ; then we try to parse the code and put result on the channel
-  (let [command (read-external-input code)]
+  ; in case the code is a special-fn call, we execute user's input
+  ; otherwise we execute code provided from client (which is a wrapped version)
+  (let [effective-code (if (is-special-fn-call? input) input code)
+        command (read-input effective-code)
+        command-record {:kind        :external
+                        :command     command
+                        :request-id  request-id
+                        :info-method info-method}]
     (go
-      (>!! repl-commands-channel command))))
+      (>!! repl-commands-channel command-record))))
+
+;(def ^:dynamic *orig-out* nil)
+;(def ^:dynamic *out-proxy-gatekeeper* 0)
+;
+;; see http://docs.oracle.com/javase/7/docs/api/java/io/Writer.html
+;(def out-proxy
+;  (proxy [StringWriter] []
+;    (write
+;      ([x]
+;       (if (zero? *out-proxy-gatekeeper*)
+;         (.write *orig-out* x))
+;       (binding [*out-proxy-gatekeeper* (inc *out-proxy-gatekeeper*)]
+;         (proxy-super write x)))
+;      ([x off len]
+;       (if (zero? *out-proxy-gatekeeper*)
+;         (.write *orig-out* x off len))
+;       (binding [*out-proxy-gatekeeper* (inc *out-proxy-gatekeeper*)]
+;         (proxy-super write x off len))))
+;    (append
+;      ([x]
+;       (if (zero? *out-proxy-gatekeeper*)
+;         (.append *orig-out* x))
+;       (binding [*out-proxy-gatekeeper* (inc *out-proxy-gatekeeper*)]
+;         (proxy-super append x)
+;         this))
+;      ([x start end]
+;       (if (zero? *out-proxy-gatekeeper*)
+;         (.append *orig-out* x start end))
+;       (binding [*out-proxy-gatekeeper* (inc *out-proxy-gatekeeper*)]
+;         (proxy-super append x start end)
+;         this)))
+;    (close
+;      ([]
+;       (.close *orig-out*)
+;       (proxy-super close)))
+;    (flush
+;      ([]
+;       (.flush *orig-out*)
+;       (proxy-super flush)))))
+
+(defn start-recording! [command-record]
+  ;(assert (not @orig-out))
+  ;(vreset! orig-out *out*)
+  ;(set! *out* out-proxy)
+  (vreset! print-recording command-record))
+
+(defn stop-recording! []
+  ;(when @orig-out
+  ;  (set! *out* @orig-out)
+  ;  (vreset! orig-out nil))
+  (vreset! print-recording nil))
 
 ; TODO: we should create one-channel-per-build-id
-(defn custom-read-fn-factory
+(defn multiplexing-reader-factory
   "This factory creates a new REPL reading function. Normally this function is responsible for waiting for user input on
   stdin, parsing it and passing a valid form back. REPL system then calls it to parse next form, and so on.
 
@@ -36,13 +122,59 @@
   [build]
   (let [pending-read? (volatile! false)]
     (fn [& args]
-      ; make sure we have pending read in-flight
-      (if-not @pending-read?
+      (if-not @active-repl-opts
+        (vreset! active-repl-opts (resolve-repl-opts)))
+
+      (stop-recording!)
+
+      ; make sure we have a pending read in-flight
+      (when-not @pending-read?
         (vreset! pending-read? true)
         (go
-          (let [command (apply cljs-repl/repl-read args)]
-            (>!! repl-commands-channel command)
+          (let [command (apply cljs-repl/repl-read args)
+                command-record {:kind    :stdin
+                                :command command}]
+            (>!! repl-commands-channel command-record)
             (vreset! pending-read? false))))
 
       ; wait & serve next input from the channel (can be produced by cljs-repl/repl-read or exec-external-command!)
-      (<!! repl-commands-channel))))
+      (let [command-record (<!! repl-commands-channel)]
+        (case (:kind command-record)
+          :stdin (:command command-record)
+          :external (do
+                      (start-recording! command-record)
+                      (:command command-record)))))))
+
+(defn info-method-call-code-snippet [request-id info-method text]
+  (let [;text (string/join " " (map str args))
+        escaped-text (-> text
+                         (string/replace #"'" "\\'")
+                         (string/replace #"\n" "\\n"))]
+    (str info-method "(" request-id ", '" escaped-text "')")))
+
+(defn print-recorder-factory [build exec-js-fn]
+  (fn [& args]
+    #_(when-let [{:keys [request-id info-method]} @print-recording]
+      (if-not @ignore-next-print
+        (let [js-code (info-method-call-code-snippet request-id info-method args)]
+          (exec-js-fn js-code))))
+    (apply println args)
+    (vreset! ignore-next-print false)))
+
+(defn signalling-eval-cljs [build]
+  (fn [& args]
+    (when-let [eval-cljs (resolve-eval-cljs)]
+      (let [result (apply eval-cljs args)]
+        ; main REPL loop calls eval and then immediatelly printr result value
+        ; if recording, we want to prevent next print to be recorded
+        (vreset! ignore-next-print true)
+        result))))
+
+(defn out-flush-handler [exec-js-fn string-writer]
+  (let [buffer (.getBuffer string-writer)
+        content (.toString string-writer)]
+    (.setLength buffer 0)
+    (when-let [{:keys [request-id info-method]} @print-recording]
+      (if-not @ignore-next-print
+        (let [js-code (info-method-call-code-snippet request-id info-method content)]
+          (exec-js-fn js-code))))))