-
-
Notifications
You must be signed in to change notification settings - Fork 2
/
thread.clj
73 lines (62 loc) · 2.37 KB
/
thread.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
(ns iced.nrepl.refactor.thread
(:require [clojure.string :as str]))
(def ^:private replace-prefix "__ICED__")
(defmulti expand-sexp (fn [sym _] sym))
(defmethod expand-sexp '->
[_ x]
(loop [x x, expanded []]
(let [[head target & tail] (if (sequential? x) x [])]
(if (and target
(not (vector? x))
(not (str/starts-with? (str head) replace-prefix)))
(recur target (conj expanded {:head head :tail tail}))
(conj expanded {:value x})))))
(defmethod expand-sexp '->>
[_ x]
(loop [x x, expanded []]
(let [[head & tail] (if (sequential? x) x [])
target (last tail)
tail (drop-last tail)]
(if (and target
(not (vector? x))
(not (str/starts-with? (str head) replace-prefix)))
(recur target (conj expanded {:head head :tail tail}))
(conj expanded {:value x})))))
(defn- construct [sym expanded]
(let [[value & bodies] (reverse expanded)]
(if bodies
(cons sym
(reduce (fn [res {:keys [head tail]}]
(conj res (if (seq tail) (cons head tail) head)))
[(:value value)] bodies))
(:value value))))
(defn- lambda-replace-pair [code]
(reduce (fn [res x]
(assoc res x (str "(" replace-prefix (subs x 2))))
{} (re-seq #"#\([^ )]+" code)))
(defn- deref-replace-pair [code]
(reduce (fn [res x]
(assoc res x (if (str/starts-with? x "@(")
(str "(" replace-prefix (subs x 2))
(str replace-prefix (subs x 1)))))
{} (re-seq #"@[^ )]+" code)))
(defn- apply-replace-pairs [code pairs]
(reduce (fn [res [before after]] (str/replace res before after))
code pairs))
(defn- rollback-replace-pairs [code pairs]
(reduce (fn [res [before after]] (str/replace res after before))
code pairs))
(defn- thread* [sym code]
(let [replace-pairs (merge (lambda-replace-pair code)
(deref-replace-pair code))
code' (apply-replace-pairs code replace-pairs)
sexp (read-string code')
expanded (expand-sexp sym sexp)]
(if (> (count expanded) 2)
(-> (construct sym expanded)
str
(str/replace "," "")
(rollback-replace-pairs replace-pairs))
code)))
(def thread-first (partial thread* '->))
(def thread-last (partial thread* '->>))