cljx nREPL middleware (WIP)

cljx.clj

(ns cemerick.cljx
  (:require [cljx.core :as cljx]
            [cljx.rules :as rules]
            [cemerick.piggieback :as piggieback]
            [clojure.string :as str]
            [clojure.tools.nrepl.middleware :refer (set-descriptor!)]
            [kibit.rules.util :refer (defrules compile-rule)]
            [clojure.core.logic :as l])
  (:use clojure.test))

;; rules and supporting fns for making Clojure catch+throw forms
;; "portable" to CLJS

(defn- exception-type-sym?
  [x]
  (and (symbol? x)
       (try
         (when-let [c (resolve x)]
           (and (class? c)
                (.isAssignableFrom Throwable c)))
         (catch ClassNotFoundException e
           false))))

(defn- strip-dot
  [x]
  (and (symbol? x)
       (not (namespace x))
       (-> x name str (str/replace #"\.$" "") symbol)))

(def catch
  (let [ex-binding (l/lvar)
        body (l/lvar)]
    [#(l/matche [%]
        ([[catch ?ex-type ex-binding . body]]
          (l/pred ?ex-type exception-type-sym?)))
     #(l/== % (l/llist 'catch 'js/Error ex-binding body))]))

(def throw
  (let [message (l/lvar)
        new-ex? (comp exception-type-sym? strip-dot)]
    [#(l/matche [%]
        ([[throw [?ex-type message]]]
          (l/pred ?ex-type new-ex?))
        ([[throw [?ex-type]]]
          (l/== message "")
          (l/pred ?ex-type new-ex?)))
     #(l/== % (list 'throw (list 'js/Error message)))]))

; just here to make it easier to fiddle with kibit/cljx rules at the REPL
(defmacro ^:private munge-exprs
  [rules & code]
  (let [code (binding [*print-meta* true]
               (apply str (map pr-str code)))]
    `(cljx/munge-forms (java.io.StringReader. ~code) ~rules)))

(def cljs-rules (list* catch throw rules/cljs-rules))

(deftest catch+throw
  (let [rules cljs-rules]
    (are [before after] (= after (->> (munge-exprs rules before)
                                   first
                                   second))
      '(try x (catch Exception e))
      '(try x (catch js/Error e))
      '(try 1 2 (foo)
         (catch IllegalArgumentException e
           (println (str e))
           (throw (Exception. (.crazymethod x (class y))))))
      '(try 1 2 (foo)
         (catch js/Error e
           (println (str e))
           (throw (js/Error (.crazymethod x (class y)))))))))

(defn- any-root-cause?
  "Returns true if any cause within [exception] is an instance of [class]."
  [class ^Throwable exception]
  (loop [exception exception]
    (when exception
      (if (instance? class exception)
        true
        (recur (.getCause exception))))))

;; actual cljx nREPL middleware starts here

(defn- munge-code
  [code rules]
  (binding [*print-meta* true]
    (try
      (apply pr-str (cljx/munge-forms (java.io.StringReader. code)
                                      rules))
      (catch Throwable e
        ;; choked reading the form; go ahead and let interruptible-eval read the original
        ;; code, so that the exception is reported properly
        (if (any-root-cause? clojure.lang.LispReader$ReaderException e)
          code
          (throw e))))))

(defn wrap-cljx
  ([h] (wrap-cljx h {:clj rules/clj-rules :cljs rules/cljs-rules}))
  ([h {:keys [clj cljs] :as rules}]
    (fn [{:keys [op code file file-name session] :as msg}]
      (let [rules (if (@session #'piggieback/*cljs-repl-env*)
                    cljs
                    clj)]
        (cond
          (and (= op "eval") code)
          (h (assoc msg :code (munge-code code rules)))
          
          (and (= op "load-file") file (re-matches #".+\.cljx$" file-name))
          (h (assoc msg :file (munge-code file rules)))
          
          :else (h msg))))))

(def wrap-cljx2 #(wrap-cljx % {:clj rules/clj-rules
                               :cljs cljs-rules}))

(set-descriptor! #'wrap-cljx
  {:requires #{"clone"}
   :expects #{#'piggieback/wrap-cljs-repl}
   :handles {}})

(set-descriptor! #'wrap-cljx2
  {:requires #{"clone"}
   :expects #{#'piggieback/wrap-cljs-repl}
   :handles {}})