SHARE
TWEET

Untitled

a guest Jun 27th, 2019 56 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (ns script
  2.   (:require
  3.     [augistints.core :as ac]
  4.     [clojure.data.json :as cdj]
  5.     [rewrite-clj.zip :as rz])
  6.   (:gen-class))
  7.  
  8. (set! *warn-on-reflection* true)
  9.  
  10. (defn find-defn-zloc-at
  11.   [forms-str row col]
  12.   (let [curr-zloc (-> (rz/of-string forms-str
  13.                                     {:track-position? true})
  14.                       (rz/find-last-by-pos [row col]))
  15.         initial-char (first (rz/string curr-zloc))
  16.         curr-zloc (if (= initial-char \()
  17.                     (rz/down curr-zloc)
  18.                     curr-zloc)]
  19.     (loop [curr-zloc curr-zloc]
  20.       (when curr-zloc
  21.         (let [lm-zloc (rz/leftmost curr-zloc)
  22.               up-zloc (rz/up lm-zloc)]
  23.           (if (#{'defn 'defn-} (rz/sexpr lm-zloc))
  24.             up-zloc
  25.             (recur up-zloc)))))))
  26.  
  27. (defn my-slurp-stdin
  28.   []
  29.   (let [sb (StringBuilder.)]
  30.     (loop [res (.read System/in)]
  31.       (when (not= -1 res)
  32.         (.append sb (char res))
  33.         (recur (.read System/in))))
  34.     (.toString sb)))
  35.  
  36. (defn -main [& args]
  37.   (let [;; XXX: expects json rpc string on stdin, e.g.
  38.         ;;        {"jsonrpc": "2.0",
  39.         ;;         "method": "inlinedef",
  40.         ;;         "params": ["(defn my-fn [a] (+ a 1))" 3 4],
  41.         ;;         "id": 1}
  42.         slurped (my-slurp-stdin)
  43.         {:keys [method params id]} (cdj/read-str slurped :key-fn keyword)
  44.         [text row col] params
  45.         defn-zloc (find-defn-zloc-at text row col)
  46.         [new-text range]
  47.          (if defn-zloc
  48.            [(-> (rz/string defn-zloc)
  49.                 (ac/prepend-to-defn-body (ac/make-inline-def-with-meta-gen
  50.                                           {:adorn/inlinedef true}))
  51.                 ac/cljfmt)
  52.             (rz/position-span defn-zloc)]
  53.            [nil nil])
  54.         ;; XXX: check for errors?
  55.         result (-> (assoc {"jsonrpc" "2.0", "id" id}
  56.                      "result" [new-text range])
  57.                    cdj/write-str)]
  58.     ;; XXX: println might work...try later
  59.     (.print System/out result)))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top