Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Support code reflection in the cljs repl.

A few changes have been made to support runtime code reflection in a
cljs repl. These include small changes to cljs.analyzer, a separation of
the server element of cljs.repl.browser into cljs.repl.server, and the
addition of two new namespaces: cljs.repl.reflect (in src/clj) and
clojure.reflect (in src/cljs).

cljs.analyzer:
- Arbitrary metadata declared on symbols will now be added to the AST.
  This supports the addition of docstrings.
- Fix a subtle bug in cljs.analyzer/analyze-file, where an uncommon
  code-path would lead to the failed coercion of an absolute-path into a
  URL. An absolute path, including a `file://` protocol, can now be
  passed into the function successfully.

cljs.repl:
- Add function to analyze source on repl-env -setup. This is used to
  support reflection on user-defined cljs source files, as well as to
  populate the cljs.analyzer/namespaces atom on repl startup.

cljs.repl.browser:
- The server element of this namespace has been factored out into
  cljs.repl.server to support other services that may require that
  functionality.

cljs.repl.server:
- Expose a simple HTTP method and predicate dispatch system to register
  handler functions for incoming requests. (Note: this system seems to
  be relatively brittle, and future change may be warranted.)

cljs.repl.reflect:
- Registers a server handler for incoming requests to "/reflect".
- Queries cljs.analyzer/namespaces for meta information relevant to a
  symbol, responding to requests with compiled javascript.
- Can use "fixed point" macroexpansion on cljs macro forms.

clojure.reflect:
- Expose a set of simple functions for querying meta information of a
  symbol, as well as macroexpanding a cljs form.
  • Loading branch information...
commit b5b20fdc4fa5c9f8a12e527407a72a7e6957bcd6 1 parent 0f73237
Zach Allaun authored July 09, 2012 David Nolen committed July 25, 2012
1  .gitignore
@@ -9,3 +9,4 @@ closure
9 9
 /coresimple.js
10 10
 /out
11 11
 .repl
  12
+*.swp
3  samples/repl/src/repl/test.cljs
@@ -7,7 +7,8 @@
7 7
 ;; You must not remove this notice, or any other, from this software.
8 8
 
9 9
 (ns repl.test
10  
-  (:require [clojure.browser.repl :as repl]))
  10
+  (:require [clojure.browser.repl :as repl]
  11
+            [clojure.reflect :as reflect]))
11 12
 
12 13
 (repl/connect "http://localhost:9000/repl")
13 14
 
16  script/browser-repl
... ...
@@ -0,0 +1,16 @@
  1
+#!/bin/sh
  2
+
  3
+if [ "$CLOJURESCRIPT_HOME" = "" ]; then
  4
+  CLOJURESCRIPT_HOME="`dirname $0`/.."
  5
+fi
  6
+
  7
+CLJSC_CP=''
  8
+for next in lib/*: src/clj: src/cljs: test/cljs; do
  9
+  CLJSC_CP=$CLJSC_CP$CLOJURESCRIPT_HOME'/'$next
  10
+done
  11
+
  12
+java -server -cp $CLJSC_CP clojure.main -e "
  13
+(require '[cljs.repl :as r])
  14
+(require '[cljs.repl.browser :as b])
  15
+(r/repl (b/repl-env))
  16
+"
11  src/clj/cljs/analyzer.clj
@@ -290,6 +290,7 @@
290 290
               ([_ sym doc init] {:sym sym :doc doc :init init}))
291 291
         args (apply pfn form)
292 292
         sym (:sym args)
  293
+        sym-meta (meta sym)
293 294
         tag (-> sym meta :tag)
294 295
         protocol (-> sym meta :protocol)
295 296
         dynamic (-> sym meta :dynamic)
@@ -326,6 +327,7 @@
326 327
                (let [m (assoc (or m {}) :name name)]
327 328
                  (merge m
328 329
                    (when tag {:tag tag})
  330
+                   (when sym-meta sym-meta)
329 331
                    (when dynamic {:dynamic true})
330 332
                    (when-let [line (:line env)]
331 333
                      {:file *cljs-file* :line line})
@@ -533,7 +535,7 @@
533 535
      (when (and known-num-fields (not= known-num-fields argc))
534 536
        (warning env
535 537
          (str "WARNING: Wrong number of args (" argc ") passed to " ctor)))
536  
-     
  538
+
537 539
      {:env env :op :new :form form :ctor ctorexpr :args argexprs
538 540
       :children (into [ctorexpr] argexprs)})))
539 541
 
@@ -677,7 +679,7 @@
677 679
                        :type true
678 680
                        :num-fields (count fields))]
679 681
                (merge m
680  
-                 {:protocols (-> tsym meta :protocols)}     
  682
+                 {:protocols (-> tsym meta :protocols)}
681 683
                  (when-let [line (:line env)]
682 684
                    {:file *cljs-file*
683 685
                     :line line})))))
@@ -935,8 +937,8 @@
935 937
         :else {:op :constant :env env :form form}))))
936 938
 
937 939
 (defn analyze-file
938  
-  [f]
939  
-  (let [res (if (= \/ (first f)) f (io/resource f))]
  940
+  [^String f]
  941
+  (let [res (if (re-find #"^file://" f) (java.net.URL. f) (io/resource f))]
940 942
     (assert res (str "Can't find " f " in classpath"))
941 943
     (binding [*cljs-ns* 'cljs.user
942 944
               *cljs-file* (.getPath ^java.net.URL res)
@@ -950,4 +952,3 @@
950 952
               (when-not (identical? eof r)
951 953
                 (analyze env r)
952 954
                 (recur (read pbr false eof false))))))))))
953  
-
16  src/clj/cljs/repl.clj
@@ -8,6 +8,7 @@
8 8
 
9 9
 (ns cljs.repl
10 10
   (:refer-clojure :exclude [load-file])
  11
+  (:import java.io.File)
11 12
   (:require [clojure.string :as string]
12 13
             [clojure.java.io :as io]
13 14
             [cljs.compiler :as comp]
@@ -149,6 +150,15 @@
149 150
      'clojure.core/load-file load-file-fn
150 151
      'load-namespace (fn [repl-env ns] (load-namespace repl-env ns))}))
151 152
 
  153
+(defn analyze-source
  154
+  "Given a source directory, analyzes all .cljs files. Used to populate
  155
+  cljs.analyzer/namespaces so as to support code reflection."
  156
+  [src-dir]
  157
+  (if-let [src-dir (and (not (empty? src-dir))
  158
+                     (File. src-dir))]
  159
+    (doseq [file (comp/cljs-files-in src-dir)]
  160
+      (ana/analyze-file (str "file://" (.getAbsolutePath file))))))
  161
+
152 162
 (defn repl
153 163
   "Note - repl will reload core.cljs every time, even if supplied old repl-env"
154 164
   [repl-env & {:keys [verbose warn-on-undeclared special-fns]}]
@@ -166,12 +176,12 @@
166 176
         (let [{:keys [status form]} (read-next-form)]
167 177
           (cond
168 178
            (= form :cljs/quit) :quit
169  
-           
  179
+
170 180
            (= status :error) (recur)
171  
-           
  181
+
172 182
            (and (seq? form) (is-special-fn? (first form)))
173 183
            (do (apply (get special-fns (first form)) repl-env (rest form)) (newline) (recur))
174  
-           
  184
+
175 185
            :else
176 186
            (do (eval-and-print repl-env env form) (recur)))))
177 187
       (-tear-down repl-env))))
234  src/clj/cljs/repl/browser.clj
@@ -8,168 +8,47 @@
8 8
 
9 9
 (ns cljs.repl.browser
10 10
   (:refer-clojure :exclude [loaded-libs])
11  
-  (:require [clojure.string :as str]
12  
-            [clojure.java.io :as io]
  11
+  (:require [clojure.java.io :as io]
13 12
             [cljs.compiler :as comp]
14 13
             [cljs.closure :as cljsc]
15  
-            [cljs.repl :as repl])
16  
-  (:import java.io.BufferedReader
17  
-           java.io.BufferedWriter
18  
-           java.io.InputStreamReader
19  
-           java.io.OutputStreamWriter
20  
-           java.net.Socket
21  
-           java.net.ServerSocket
22  
-           cljs.repl.IJavaScriptEnv))
23  
-
24  
-(defonce server-state (atom {:socket nil
25  
-                             :connection nil
26  
-                             :promised-conn nil
27  
-                             :return-value-fn nil
28  
-                             :client-js nil}))
  14
+            [cljs.repl :as repl]
  15
+            [cljs.repl.server :as server])
  16
+  (:import cljs.repl.IJavaScriptEnv))
  17
+
  18
+(defonce browser-state (atom {:return-value-fn nil
  19
+                              :client-js nil}))
29 20
 
30 21
 (def loaded-libs (atom #{}))
31 22
 (def preloaded-libs (atom #{}))
32 23
 
33  
-(defn- connection
34  
-  "Promise to return a connection when one is available. If a
35  
-  connection is not available, store the promise in server-state."
36  
-  []
37  
-  (let [p (promise)
38  
-        conn (:connection @server-state)]
39  
-    (if (and conn (not (.isClosed conn)))
40  
-      (do (deliver p conn)
41  
-          p)
42  
-      (do (swap! server-state (fn [old] (assoc old :promised-conn p)))
43  
-          p))))
44  
-
45  
-(defn- set-connection
46  
-  "Given a new available connection, either use it to deliver the
47  
-  connection which was promised or store the connection for later
48  
-  use."
49  
-  [conn]
50  
-  (if-let [promised-conn (:promised-conn @server-state)]
51  
-    (do (swap! server-state (fn [old] (-> old
52  
-                                         (assoc :connection nil)
53  
-                                         (assoc :promised-conn nil))))
54  
-        (deliver promised-conn conn))
55  
-    (swap! server-state (fn [old] (assoc old :connection conn)))))
56  
-
57 24
 (defn- set-return-value-fn
58 25
   "Save the return value function which will be called when the next
59 26
   return value is received."
60 27
   [f]
61  
-  (swap! server-state (fn [old] (assoc old :return-value-fn f))))
62  
-
63  
-(defn- status-line [status]
64  
-  (case status
65  
-    200 "HTTP/1.1 200 OK"
66  
-    404 "HTTP/1.1 404 Not Found"
67  
-    "HTTP/1.1 500 Error"))
68  
-
69  
-(defn send-and-close
70  
-  "Use the passed connection to send a form to the browser. Send a
71  
-  proper HTTP response."
72  
-  ([conn status form]
73  
-     (send-and-close conn status form "text/html"))
74  
-  ([conn status form content-type]
75  
-     (let [utf-8-form (.getBytes form "UTF-8")
76  
-           content-length (count utf-8-form)
77  
-           headers (map #(.getBytes (str % "\r\n"))
78  
-                        [(status-line status)
79  
-                         "Server: ClojureScript REPL"
80  
-                         (str "Content-Type: "
81  
-                              content-type
82  
-                              "; charset=utf-8")
83  
-                         (str "Content-Length: " content-length)
84  
-                         ""])]
85  
-       (with-open [os (.getOutputStream conn)]
86  
-         (do (doseq [header headers]
87  
-               (.write os header 0 (count header)))
88  
-             (.write os utf-8-form 0 content-length)
89  
-             (.flush os)
90  
-             (.close conn))))))
91  
-
92  
-(defn send-404 [conn path]
93  
-  (send-and-close conn 404
94  
-                  (str "<html><body>"
95  
-                       "<h2>Page not found</h2>"
96  
-                       "No page " path " found on this server."
97  
-                       "</body></html>")
98  
-                  "text/html"))
  28
+  (swap! browser-state (fn [old] (assoc old :return-value-fn f))))
99 29
 
100 30
 (defn send-for-eval
101 31
   "Given a form and a return value function, send the form to the
102 32
   browser for evaluation. The return value function will be called
103 33
   when the return value is received."
104 34
   ([form return-value-fn]
105  
-     (send-for-eval @(connection) form return-value-fn))
  35
+     (send-for-eval @(server/connection) form return-value-fn))
106 36
   ([conn form return-value-fn]
107 37
      (do (set-return-value-fn return-value-fn)
108  
-         (send-and-close conn 200 form "text/javascript"))))
  38
+         (server/send-and-close conn 200 form "text/javascript"))))
109 39
 
110 40
 (defn- return-value
111 41
   "Called by the server when a return value is received."
112 42
   [val]
113  
-  (when-let [f (:return-value-fn @server-state)]
  43
+  (when-let [f (:return-value-fn @browser-state)]
114 44
     (f val)))
115 45
 
116  
-(defn parse-headers
117  
-  "Parse the headers of an HTTP POST request."
118  
-  [header-lines]
119  
-  (apply hash-map
120  
-   (mapcat
121  
-    (fn [line]
122  
-      (let [[k v] (str/split line #":" 2)]
123  
-        [(keyword (str/lower-case k)) (str/triml v)]))
124  
-    header-lines)))
125  
-
126  
-(comment
127  
-
128  
-  (parse-headers
129  
-   ["Host: www.mysite.com"
130  
-    "User-Agent: Mozilla/4.0"
131  
-    "Content-Length: 27"
132  
-    "Content-Type: application/x-www-form-urlencoded"])
133  
-)
134  
-
135  
-;;; assumes first line already consumed
136  
-(defn read-headers [rdr]
137  
-  (loop [next-line (.readLine rdr)
138  
-         header-lines []]
139  
-    (if (= "" next-line)
140  
-      header-lines                      ;we're done reading headers
141  
-      (recur (.readLine rdr) (conj header-lines next-line)))))
142  
-
143  
-(defn read-post [line rdr]
144  
-  (let [[_ path _] (str/split line #" ")
145  
-        headers (parse-headers (read-headers rdr))
146  
-        content-length (Integer/parseInt (:content-length headers))
147  
-        content (char-array content-length)]
148  
-    (io! (.read rdr content 0 content-length)
149  
-         {:method :post
150  
-          :path path
151  
-          :headers headers
152  
-          :content (String. content)})))
153  
-
154  
-(defn read-get [line rdr]
155  
-  (let [[_ path _] (str/split line #" ")
156  
-        headers (parse-headers (read-headers rdr))]
157  
-    {:method :get
158  
-     :path path
159  
-     :headers headers}))
160  
-
161  
-(defn read-request [rdr]
162  
-  (let [line (.readLine rdr)]
163  
-    (cond (.startsWith line "POST") (read-post line rdr)
164  
-          (.startsWith line "GET") (read-get line rdr)
165  
-          :else {:method :unknown :content line})))
166  
-
167 46
 (defn repl-client-js []
168  
-  (slurp @(:client-js @server-state)))
  47
+  (slurp @(:client-js @browser-state)))
169 48
 
170 49
 (defn send-repl-client-page
171  
-  [opts conn request]
172  
-  (send-and-close conn 200
  50
+  [request conn opts]
  51
+  (server/send-and-close conn 200
173 52
     (str "<html><head><meta charset=\"UTF-8\"></head><body>
174 53
           <script type=\"text/javascript\">"
175 54
          (repl-client-js)
@@ -180,7 +59,7 @@
180 59
          "</body></html>")
181 60
     "text/html"))
182 61
 
183  
-(defn send-static [opts conn {path :path :as request}]
  62
+(defn send-static [{path :path :as request} conn opts]
184 63
   (if (and (:static-dir opts)
185 64
            (not= "/favicon.ico" path))
186 65
     (let [path   (if (= "/" path) "/index.html" path)
@@ -188,28 +67,31 @@
188 67
       (if-let [local-path (seq (for [x (if (string? st-dir) [st-dir] st-dir)
189 68
                                      :when (.exists (io/file (str x path)))]
190 69
                                  (str x path)))]
191  
-        (send-and-close conn 200 (slurp (first local-path))
  70
+        (server/send-and-close conn 200 (slurp (first local-path))
192 71
                         (condp #(.endsWith %2 %1) path
193 72
                           ".js" "text/javascript"
194 73
                           ".html" "text/html"
195 74
                           "text/plain"))
196  
-        (send-404 conn path)))
197  
-    (send-404 conn path)))
  75
+        (server/send-404 conn path)))
  76
+    (server/send-404 conn path)))
198 77
 
199  
-(defn handle-get [opts conn request]
200  
-  (let [path (:path request)]
201  
-    (cond
202  
-     (.startsWith path "/repl") (send-repl-client-page opts conn request)
203  
-     (:serve-static opts) (send-static opts conn request)
204  
-     :else (send-404 conn (:path request)))))
  78
+(server/dispatch-on :get
  79
+                    (fn [{:keys [path]} _ _] (.startsWith path "/repl"))
  80
+                    send-repl-client-page)
205 81
 
206  
-(declare browser-eval)
  82
+(server/dispatch-on :get
  83
+                    (fn [{:keys [path]} _ _] (or (= path "/")
  84
+                                                (.endsWith path ".js")
  85
+                                                (.endsWith path ".html")))
  86
+                    send-static)
207 87
 
208  
-(def ordering (agent {:expecting nil :fns {}}))
  88
+(defmulti handle-post (fn [m _ _ ] (:type m)))
  89
+
  90
+(server/dispatch-on :post (constantly true) handle-post)
209 91
 
210  
-(defmulti handle-post (fn [_ m] (:type m)))
  92
+(def ordering (agent {:expecting nil :fns {}}))
211 93
 
212  
-(defmethod handle-post :ready [conn _]
  94
+(defmethod handle-post :ready [_ conn _]
213 95
   (do (reset! loaded-libs @preloaded-libs)
214 96
       (send ordering (fn [_] {:expecting nil :fns {}}))
215 97
       (send-for-eval conn
@@ -236,42 +118,14 @@
236 118
   (send-off ordering add-in-order order f)
237 119
   (send-off ordering run-in-order))
238 120
 
239  
-(defmethod handle-post :print [conn {:keys [content order]}]
  121
+(defmethod handle-post :print [{:keys [content order]} conn _ ]
240 122
   (do (constrain-order order (fn [] (do (print (read-string content))
241 123
                                        (.flush *out*))))
242  
-      (send-and-close conn 200 "ignore__")))
  124
+      (server/send-and-close conn 200 "ignore__")))
243 125
 
244  
-(defmethod handle-post :result [conn {:keys [content order]}]
  126
+(defmethod handle-post :result [{:keys [content order]} conn _ ]
245 127
   (constrain-order order (fn [] (do (return-value content)
246  
-                                   (set-connection conn)))))
247  
-
248  
-(defn handle-connection
249  
-  [opts conn]
250  
-  (let [rdr (BufferedReader. (InputStreamReader. (.getInputStream conn)))]
251  
-    (if-let [request (read-request rdr)]
252  
-      (case (:method request)
253  
-        :get (handle-get opts conn request)
254  
-        :post (handle-post conn (read-string (:content request)))
255  
-        (.close conn))
256  
-      (.close conn))))
257  
-
258  
-(defn server-loop
259  
-  [opts server-socket]
260  
-  (let [conn (.accept server-socket)]
261  
-    (do (.setKeepAlive conn true)
262  
-        (future (handle-connection opts conn))
263  
-        (recur opts server-socket))))
264  
-
265  
-(defn start-server
266  
-  "Start the server on the specified port."
267  
-  [opts]
268  
-  (let [ss (ServerSocket. (:port opts))]
269  
-    (future (server-loop opts ss))
270  
-    (swap! server-state (fn [old] (assoc old :socket ss :port (:port opts))))))
271  
-
272  
-(defn stop-server
273  
-  []
274  
-  (.close (:socket @server-state)))
  128
+                                   (server/set-connection conn)))))
275 129
 
276 130
 (defn browser-eval
277 131
   "Given a string of JavaScript, evaluate it in the browser and return a map representing the
@@ -305,12 +159,15 @@
305 159
 (extend-protocol repl/IJavaScriptEnv
306 160
   clojure.lang.IPersistentMap
307 161
   (-setup [this]
308  
-    (comp/with-core-cljs (start-server this)))
  162
+    (do (require 'cljs.repl.reflect)
  163
+        (repl/analyze-source (:src this))
  164
+        (comp/with-core-cljs (server/start this))))
309 165
   (-evaluate [_ _ _ js] (browser-eval js))
310 166
   (-load [this ns url] (load-javascript this ns url))
311 167
   (-tear-down [_]
312  
-    (do (stop-server)
313  
-        (reset! server-state {}))))
  168
+    (do (server/stop)
  169
+        (reset! server/state {})
  170
+        (reset! browser-state {}))))
314 171
 
315 172
 (defn compile-client-js [opts]
316 173
   (cljsc/build '[(ns clojure.browser.repl.client
@@ -361,6 +218,8 @@
361 218
                   loading code and reloading it would cause a problem.
362 219
   optimizations:  The level of optimization to use when compiling the client
363 220
                   end of the REPL. Defaults to :simple.
  221
+  src:            The source directory containing user-defined cljs files. Used to
  222
+                  support reflection. Defaults to \"src/\".
364 223
   "
365 224
   [& {:as opts}]
366 225
   (let [opts (merge {:port          9000
@@ -368,11 +227,12 @@
368 227
                      :working-dir   ".repl"
369 228
                      :serve-static  true
370 229
                      :static-dir    ["." "out/"]
371  
-                     :preloaded-libs   []}
  230
+                     :preloaded-libs   []
  231
+                     :src           "src/"}
372 232
                     opts)]
373 233
     (do (reset! preloaded-libs (set (concat (always-preload) (map str (:preloaded-libs opts)))))
374 234
         (reset! loaded-libs @preloaded-libs)
375  
-        (swap! server-state
  235
+        (swap! browser-state
376 236
                (fn [old] (assoc old :client-js
377 237
                                (future (create-client-js-file
378 238
                                         opts
@@ -380,7 +240,7 @@
380 240
         opts)))
381 241
 
382 242
 (comment
383  
-  
  243
+
384 244
   (require '[cljs.repl :as repl])
385 245
   (require '[cljs.repl.browser :as browser])
386 246
   (def env (browser/repl-env))
74  src/clj/cljs/repl/reflect.clj
... ...
@@ -0,0 +1,74 @@
  1
+(ns cljs.repl.reflect
  2
+  (:refer-clojure :exclude [macroexpand])
  3
+  (:require [cljs.repl.server :as server]
  4
+            [cljs.analyzer :as analyzer]
  5
+            [cljs.compiler :as compiler]
  6
+            [clojure.string :as str]))
  7
+
  8
+(defn- dissoc-unless
  9
+  "Dissoc all keys from map that do not appear in key-set.
  10
+
  11
+    (dissoc-unless {:foo 1 :bar 2} #{:foo})
  12
+    => {:foo 1}"
  13
+  [m key-set]
  14
+  {:pre [(map? m)
  15
+         (set? key-set)]}
  16
+  (reduce (fn [coll key]
  17
+            (if (contains? key-set key)
  18
+              coll
  19
+              (dissoc coll key)))
  20
+          m (keys m)))
  21
+
  22
+(defn- get-meta [sym]
  23
+  (let [ns (symbol (namespace sym))
  24
+        n  (symbol (name sym))]
  25
+    (if-let [sym-meta (get (:defs (get @analyzer/namespaces ns)) n)]
  26
+      (-> (dissoc-unless sym-meta
  27
+                         #{:name :method-params :doc :line :file})
  28
+          (update-in [:name] str)
  29
+          (update-in [:method-params] #(str (vec %)))))))
  30
+
  31
+(defn macroexpand [form]
  32
+  "Fully expands a cljs macro form."
  33
+  (let [mform (analyzer/macroexpand-1 {} form)]
  34
+    (if (identical? form mform)
  35
+      mform
  36
+      (macroexpand mform))))
  37
+
  38
+(defn- url-decode [encoded & [encoding]]
  39
+  (java.net.URLDecoder/decode encoded (or encoding "UTF-8")))
  40
+
  41
+(def read-url-string (comp read-string url-decode))
  42
+
  43
+(defn parse-param
  44
+  "Parses the query parameter of a path of the form \"/reflect?var=foo\"
  45
+  into the vector [\"var\" \"foo\"]."
  46
+  [path]
  47
+  (-> (str/split path #"\?")
  48
+      (last)
  49
+      (str/split #"=")))
  50
+
  51
+(defn- compile-and-return
  52
+  "Compiles a form to javascript and returns it on conn."
  53
+  [conn form]
  54
+  (let [ast (analyzer/analyze {:ns {:name 'cljs.user}} form)
  55
+        js  (try (compiler/emit-str ast)
  56
+                 (catch Exception e (println e)))]
  57
+    (server/send-and-close conn 200 js "text/javascript")))
  58
+
  59
+(defmulti handle-reflect-query (fn [[param _] & _] param))
  60
+
  61
+(defmethod handle-reflect-query "var"
  62
+  [[_ sym] req conn opts]
  63
+  (let [sym (read-url-string sym)]
  64
+    (compile-and-return conn (get-meta sym))))
  65
+
  66
+(defmethod handle-reflect-query "macroform"
  67
+  [[_ mform] req conn opts]
  68
+  (let [mform (-> mform read-url-string macroexpand)]
  69
+    (server/send-and-close conn 200 (str mform))))
  70
+
  71
+(server/dispatch-on :get
  72
+                    (fn [{:keys [path]} _ _] (.startsWith path "/reflect"))
  73
+                    (fn [{:keys [path] :as req} conn opts]
  74
+                      (handle-reflect-query (parse-param path) req conn opts)))
173  src/clj/cljs/repl/server.clj
... ...
@@ -0,0 +1,173 @@
  1
+(ns cljs.repl.server
  2
+  (:refer-clojure :exclude [loaded-libs])
  3
+  (:require [clojure.string :as str]
  4
+            [clojure.java.io :as io]
  5
+            [cljs.compiler :as comp]
  6
+            [cljs.closure :as cljsc]
  7
+            [cljs.repl :as repl])
  8
+  (:import java.io.BufferedReader
  9
+           java.io.BufferedWriter
  10
+           java.io.InputStreamReader
  11
+           java.io.OutputStreamWriter
  12
+           java.net.Socket
  13
+           java.net.ServerSocket
  14
+           cljs.repl.IJavaScriptEnv))
  15
+
  16
+(defonce state (atom {:socket nil
  17
+                      :connection nil
  18
+                      :promised-conn nil}))
  19
+
  20
+(defn connection
  21
+  "Promise to return a connection when one is available. If a
  22
+  connection is not available, store the promise in server/state."
  23
+  []
  24
+  (let [p (promise)
  25
+        conn (:connection @state)]
  26
+    (if (and conn (not (.isClosed conn)))
  27
+      (do (deliver p conn)
  28
+          p)
  29
+      (do (swap! state (fn [old] (assoc old :promised-conn p)))
  30
+          p))))
  31
+
  32
+(defn set-connection
  33
+  "Given a new available connection, either use it to deliver the
  34
+  connection which was promised or store the connection for later
  35
+  use."
  36
+  [conn]
  37
+  (if-let [promised-conn (:promised-conn @state)]
  38
+    (do (swap! state (fn [old] (-> old
  39
+                                         (assoc :connection nil)
  40
+                                         (assoc :promised-conn nil))))
  41
+        (deliver promised-conn conn))
  42
+    (swap! state (fn [old] (assoc old :connection conn)))))
  43
+
  44
+(defonce handlers (atom {}))
  45
+
  46
+(defn dispatch-on
  47
+  "Registers a handler to be dispatched based on a request method and a
  48
+  predicate.
  49
+
  50
+  pred should be a function that accepts an options map, a connection,
  51
+  and a request map and returns a boolean value based on whether or not
  52
+  that request should be dispatched to the related handler."
  53
+  ([method pred handler]
  54
+     (dispatch-on method {:pred pred :handler handler}))
  55
+  ([method {:as m}]
  56
+     (swap! handlers (fn [old]
  57
+                       (update-in old [method] #(conj (vec %) m))))))
  58
+
  59
+;;; assumes first line already consumed
  60
+(defn parse-headers
  61
+  "Parse the headers of an HTTP POST request."
  62
+  [header-lines]
  63
+  (apply hash-map
  64
+   (mapcat
  65
+    (fn [line]
  66
+      (let [[k v] (str/split line #":" 2)]
  67
+        [(keyword (str/lower-case k)) (str/triml v)]))
  68
+    header-lines)))
  69
+
  70
+(defn read-headers [rdr]
  71
+  (loop [next-line (.readLine rdr)
  72
+         header-lines []]
  73
+    (if (= "" next-line)
  74
+      header-lines                      ;we're done reading headers
  75
+      (recur (.readLine rdr) (conj header-lines next-line)))))
  76
+
  77
+(defn read-post [line rdr]
  78
+  (let [[_ path _] (str/split line #" ")
  79
+        headers (parse-headers (read-headers rdr))
  80
+        content-length (Integer/parseInt (:content-length headers))
  81
+        content (char-array content-length)]
  82
+    (io! (.read rdr content 0 content-length)
  83
+         {:method :post
  84
+          :path path
  85
+          :headers headers
  86
+          :content (String. content)})))
  87
+
  88
+(defn read-get [line rdr]
  89
+  (let [[_ path _] (str/split line #" ")
  90
+        headers (parse-headers (read-headers rdr))]
  91
+    {:method :get
  92
+     :path path
  93
+     :headers headers}))
  94
+
  95
+(defn read-request [rdr]
  96
+  (let [line (.readLine rdr)]
  97
+    (cond (.startsWith line "POST") (read-post line rdr)
  98
+          (.startsWith line "GET") (read-get line rdr)
  99
+          :else {:method :unknown :content line})))
  100
+
  101
+(defn- status-line [status]
  102
+  (case status
  103
+    200 "HTTP/1.1 200 OK"
  104
+    404 "HTTP/1.1 404 Not Found"
  105
+    "HTTP/1.1 500 Error"))
  106
+
  107
+(defn send-and-close
  108
+  "Use the passed connection to send a form to the browser. Send a
  109
+  proper HTTP response."
  110
+  ([conn status form]
  111
+     (send-and-close conn status form "text/html"))
  112
+  ([conn status form content-type]
  113
+     (let [utf-8-form (.getBytes form "UTF-8")
  114
+           content-length (count utf-8-form)
  115
+           headers (map #(.getBytes (str % "\r\n"))
  116
+                        [(status-line status)
  117
+                         "Server: ClojureScript REPL"
  118
+                         (str "Content-Type: "
  119
+                              content-type
  120
+                              "; charset=utf-8")
  121
+                         (str "Content-Length: " content-length)
  122
+                         ""])]
  123
+       (with-open [os (.getOutputStream conn)]
  124
+         (do (doseq [header headers]
  125
+               (.write os header 0 (count header)))
  126
+             (.write os utf-8-form 0 content-length)
  127
+             (.flush os)
  128
+             (.close conn))))))
  129
+
  130
+(defn send-404 [conn path]
  131
+  (send-and-close conn 404
  132
+                  (str "<html><body>"
  133
+                       "<h2>Page not found</h2>"
  134
+                       "No page " path " found on this server."
  135
+                       "</body></html>")
  136
+                  "text/html"))
  137
+
  138
+(defn- dispatch-request [request conn opts]
  139
+  (if-let [handlers ((:method request) @handlers)]
  140
+    (if-let [handler (some (fn [{:keys [pred handler]}]
  141
+                             (when (pred request conn opts)
  142
+                               handler))
  143
+                           handlers)]
  144
+      (if (= :post (:method request))
  145
+        (handler (read-string (:content request)) conn opts )
  146
+        (handler request conn opts))
  147
+      (send-404 conn (:path request)))
  148
+    (.close conn)))
  149
+
  150
+(defn- handle-connection
  151
+  [opts conn]
  152
+  (let [rdr (BufferedReader. (InputStreamReader. (.getInputStream conn)))]
  153
+    (if-let [request (read-request rdr)]
  154
+      (dispatch-request request conn opts)
  155
+      (.close conn))))
  156
+
  157
+(defn- server-loop
  158
+  [opts server-socket]
  159
+  (let [conn (.accept server-socket)]
  160
+    (do (.setKeepAlive conn true)
  161
+        (future (handle-connection opts conn))
  162
+        (recur opts server-socket))))
  163
+
  164
+(defn start
  165
+  "Start the server on the specified port."
  166
+  [opts]
  167
+  (let [ss (ServerSocket. (:port opts))]
  168
+    (future (server-loop opts ss))
  169
+    (swap! state (fn [old] (assoc old :socket ss :port (:port opts))))))
  170
+
  171
+(defn stop
  172
+  []
  173
+  (.close (:socket @state)))
45  src/cljs/clojure/reflect.cljs
... ...
@@ -0,0 +1,45 @@
  1
+(ns clojure.reflect
  2
+  (:require [clojure.browser.net :as net]
  3
+            [clojure.browser.event :as event]))
  4
+
  5
+(defn- evaluate-javascript [block]
  6
+  (let [result (try (js* "eval(~{block})")
  7
+                    (catch js/Error e
  8
+                      (.log js/console e)))]
  9
+    result))
  10
+
  11
+(defn- query-reflection
  12
+  "Issues a GET to /reflect with a single query-parameter string.
  13
+  Calls cb with the result."
  14
+  [query-param cb]
  15
+  (let [conn (net/xhr-connection)
  16
+        url  (str "/reflect?" query-param)]
  17
+    (event/listen conn :success (fn [e]
  18
+                                  (let [resp (.getResponseText e/currentTarget ())]
  19
+                                    (cb resp))))
  20
+    (event/listen conn :error #(println "Reflection query failed."))
  21
+    (net/transmit conn url)))
  22
+
  23
+(defn query-meta
  24
+  "Queries the reflection api with a fully qualified symbol, then calls
  25
+  callback fn cb with the evaluated cljs map containing that symbol's
  26
+  meta information."
  27
+  [sym cb]
  28
+  (query-reflection (str "var=" (js/encodeURIComponent (str sym)))
  29
+                    #(cb (evaluate-javascript %))))
  30
+
  31
+(defn query-macroexpand
  32
+  "Queries the reflection api with a quoted macro form, then calls the
  33
+  callback function with the macroexpanded form, as a string."
  34
+  [form]
  35
+  (query-reflection (str "macroform=" (js/encodeURIComponent (str form))) println))
  36
+
  37
+(defn print-doc [{:keys [name method-params doc]}]
  38
+  (when-not (empty? name)
  39
+    (println name)
  40
+    (println method-params)
  41
+    (println doc)))
  42
+
  43
+(defn query-doc [sym]
  44
+  (query-meta sym print-doc))
  45
+

0 notes on commit b5b20fd

Please sign in to comment.
Something went wrong with that request. Please try again.