-
Notifications
You must be signed in to change notification settings - Fork 175
/
ns.clj
144 lines (123 loc) · 4.13 KB
/
ns.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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(ns cider.nrepl.middleware.ns
(:refer-clojure :exclude [ns-aliases])
(:require
[cider.nrepl.middleware.util :as util]
[cider.nrepl.middleware.util.cljs :as cljs]
[cider.nrepl.middleware.util.coerce :as util.coerce]
[cider.nrepl.middleware.util.error-handling :refer [with-safe-transport]]
[cider.nrepl.middleware.util.meta :as um]
[orchard.cljs.analysis :as cljs-analysis]
[clojure.java.io :as io]
[orchard.info :as info]
[orchard.misc :as misc]
[orchard.namespace :as ns]
[orchard.query :as query]))
(defn ns-list-vars-by-name
"Return a list of vars named `name` amongst all namespaces.
`name` is a symbol."
[name]
(->> (mapcat ns-interns (all-ns))
(filter #(= (first %) name))
(map second)))
(defn ns-vars-clj [ns & [var-query]]
(->> {:ns-query {:exactly [ns]}}
(merge var-query)
util.coerce/var-query
query/vars
(map (comp str :name meta))
sort))
(defn ns-vars-with-meta-clj [ns & [var-query]]
(->> {:ns-query {:exactly [ns]}}
(merge var-query)
util.coerce/var-query
query/vars
(map meta)
(map (juxt (comp str :name) um/relevant-meta))
(into (sorted-map))))
(defn ns-list-cljs [env]
(->> (cljs-analysis/all-ns env)
keys
(map name)
sort))
(defn ns-vars-cljs [env ns & [var-query]]
(let [fetch-vars (if (:private? var-query)
(partial cljs-analysis/ns-interns-from-env env)
(partial cljs-analysis/public-vars env))]
(->> (symbol ns)
fetch-vars
keys
(map name)
sort)))
(defn ns-vars-with-meta-cljs [env ns & [var-query]]
(let [fetch-vars (if (:private? var-query)
(partial cljs-analysis/ns-interns-from-env env)
(partial cljs-analysis/public-vars env))]
(->> (symbol ns)
fetch-vars
(misc/update-vals (comp um/relevant-meta :meta))
(misc/update-keys name)
(into (sorted-map)))))
(defn ns-list [{:keys [filter-regexps] :as msg}]
(if-let [cljs-env (cljs/grab-cljs-env msg)]
(ns-list-cljs cljs-env)
(ns/loaded-namespaces filter-regexps)))
(defn ns-vars [{:keys [ns var-query] :as msg}]
(if-let [cljs-env (cljs/grab-cljs-env msg)]
(ns-vars-cljs cljs-env ns var-query)
(ns-vars-clj ns var-query)))
(defn ns-vars-with-meta [{:keys [ns var-query] :as msg}]
(if-let [cljs-env (cljs/grab-cljs-env msg)]
(ns-vars-with-meta-cljs cljs-env ns var-query)
(ns-vars-with-meta-clj ns var-query)))
(defn ns-path [{:keys [ns] :as msg}]
(if-let [cljs-env (cljs/grab-cljs-env msg)]
(:file (info/info* {:dialect :cljs
:env cljs-env
:sym (symbol ns)}))
(str (ns/canonical-source ns))))
(defn ns-list-reply [msg]
{:ns-list (ns-list msg)})
(defn ns-list-vars-by-name-reply [{:keys [name]}]
{:var-list (pr-str (ns-list-vars-by-name (symbol name)))})
(defn ns-vars-reply
[msg]
{:ns-vars (ns-vars msg)})
(defn ns-vars-with-meta-reply
[msg]
{:ns-vars-with-meta (ns-vars-with-meta msg)})
(defn- ns-path-reply [msg]
(let [v (ns-path msg)
cljs? (cljs/grab-cljs-env msg)]
{:path v
:url (if cljs?
(or (some-> v io/resource str)
v)
v)}))
(defn- ns-load-all-reply
[_msg]
{:loaded-ns (ns/load-project-namespaces)})
(defn- ns-aliases-clj [ns]
(->> (symbol ns)
(clojure.core/ns-aliases)
(misc/update-vals ns-name)
(util/transform-value)))
(defn- ns-aliases-cljs [env ns]
(->> (cljs-analysis/ns-aliases env ns)
(remove (fn [[k v]] (= k v)))
(into {})
(util/transform-value)))
(defn ns-aliases [{:keys [ns] :as msg}]
(if-let [cljs-env (cljs/grab-cljs-env msg)]
(ns-aliases-cljs cljs-env ns)
(ns-aliases-clj ns)))
(defn- ns-aliases-reply [msg]
{:ns-aliases (ns-aliases msg)})
(defn handle-ns [handler msg]
(with-safe-transport handler msg
"ns-list" ns-list-reply
"ns-list-vars-by-name" ns-list-vars-by-name-reply
"ns-vars" ns-vars-reply
"ns-vars-with-meta" ns-vars-with-meta-reply
"ns-path" ns-path-reply
"ns-load-all" ns-load-all-reply
"ns-aliases" ns-aliases-reply))