Skip to content

Commit

Permalink
Port ClojureScript info op from cljs-tooling
Browse files Browse the repository at this point in the history
In order to start consolidating Clojure and ClojureScript tooling under our
apple orchard, this patch starts porting the info op from cljs-tooling.
Consequently, it paves the way to port some of the orchard Clojure-only code to
ClojureScript.
  • Loading branch information
arichiardi committed Jan 22, 2019
1 parent 4695909 commit 69d85e0
Show file tree
Hide file tree
Showing 25 changed files with 1,438 additions and 286 deletions.
10 changes: 6 additions & 4 deletions Makefile
Expand Up @@ -9,8 +9,10 @@ JAVA_VERSION := $(shell lein with-profile +sysutils \
sysutils :java-version-simple | cut -d " " -f 2)
TEST_SELECTOR := :java$(JAVA_VERSION)

TEST_PROFILES := +test

test:
lein with-profile +$(VERSION) test $(TEST_SELECTOR)
lein with-profile +$(VERSION),$(TEST_PROFILES) test $(TEST_SELECTOR)

# Documentation management via autodoc (https://github.com/plexus/autodoc)
# Pin a specific commit in that repo to prevent accidental changes in
Expand All @@ -36,19 +38,19 @@ docs: autodoc.sh
# tools.jar isn't in the classpath when Eastwood runs.

eastwood:
lein with-profile +$(VERSION),+eastwood eastwood \
lein with-profile +$(VERSION),+eastwood,$(TEST_PROFILES) eastwood \
"{:exclude-namespaces [orchard.java.parser]}"

cljfmt:
lein with-profile +$(VERSION),+cljfmt cljfmt check
lein with-profile +$(VERSION),+cljfmt,$(TEST_PROFILES) cljfmt check

# Cloverage can't handle some of the code in this project. For now we
# must filter problematic namespaces (`-e`) and tests (`-t`) from
# instrumentation. Note: this means for now coverage reporting isn't
# exact. See issue cider-nrepl/#457 for background.

cloverage:
lein with-profile +$(VERSION),+cloverage cloverage --codecov \
lein with-profile +$(VERSION),+cloverage,$(TEST_PROFILES) cloverage --codecov \
-e "orchard.java.parser"

# When releasing, the BUMP variable controls which field in the
Expand Down
17 changes: 15 additions & 2 deletions project.clj
Expand Up @@ -10,12 +10,14 @@
;; See also https://github.com/clojure-emacs/cider-nrepl/issues/482
[org.tcrawley/dynapath "0.2.5"]
[org.clojure/java.classpath "0.3.0"]
[org.clojure/tools.namespace "0.3.0-alpha4"]]
[org.clojure/tools.namespace "0.3.0-alpha4"]
[org.clojure/clojurescript "1.10.439" :scope "provided"]]
:exclusions [org.clojure/clojure] ; see versions matrix below

:test-selectors {:java9 (complement :java9-excluded)}

:aliases {"bump-version" ["change" "version" "leiningen.release/bump-version"]}
:aliases {"bump-version" ["change" "version" "leiningen.release/bump-version"]
"test-watch" ["trampoline" "with-profile" "+1.9,+test" "test-refresh"]}

:release-tasks [["vcs" "assert-committed"]
["bump-version" "release"]
Expand All @@ -41,6 +43,17 @@

:sysutils {:plugins [[lein-sysutils "0.2.0"]]}

;; DEV tools
:test {:dependencies [[pjstadig/humane-test-output "0.9.0"]
[org.clojure/core.async "0.4.474" :exclusions [org.clojure/tools.reader]]
;; mount is self-host compatible so choosen for testing
[mount "0.1.15" :scope "test"]]
:resource-paths ["test-resources"]
:plugins [[com.jakemccrary/lein-test-refresh "0.23.0"]]
:injections [(require 'pjstadig.humane-test-output)
(pjstadig.humane-test-output/activate!)]
:test-refresh {:changes-only true}}

;; CI tools
:codox {:plugins [[lein-codox "0.10.3"]]
:codox #=(eval
Expand Down
8 changes: 8 additions & 0 deletions scripts/test-cljs
@@ -0,0 +1,8 @@
#!/usr/bin/env sh

set -eu

# useful for checking the dependency tree
# lein trampoline with-profile cljs,1.9 deps :tree

lein trampoline with-profile cljs,1.9,test-refresh test-refresh $@
231 changes: 231 additions & 0 deletions src/orchard/cljs/analysis.cljc
@@ -0,0 +1,231 @@
(ns orchard.cljs.analysis
(:require [orchard.misc :as u]
#?(:clj [cljs.repl]
:cljs [orchard.cljs.special :as special]))
(:refer-clojure :exclude [find-ns find-var all-ns ns-aliases]))

(def NSES :cljs.analyzer/namespaces)

(defn all-ns
[env]
(->> (NSES env)
;; recent CLJS versions include data about macro namespaces in the
;; compiler env, but we should not include them in completions or pass
;; them to format-ns unless they're actually required (which is handled
;; by macro-ns-candidates below)
(into {} (filter (fn [[_ ns]]
(not (and (contains? ns :macros)
(= 1 (count ns)))))))))

(defn find-ns
[env ns]
(get (all-ns env) ns))

;; Code adapted from clojure-complete (http://github.com/ninjudd/clojure-complete)

(defn imports
"Returns a map of [import-name] to [ns-qualified-import-name] for all imports
in the given namespace."
[env ns]
(:imports (find-ns env ns)))

(defn ns-aliases
"Returns a map of [ns-name-or-alias] to [ns-name] for the given namespace."
[env ns]
(let [imports (imports env ns)]
(->> (find-ns env ns)
:requires
(filter #(not (contains? imports (key %))))
(into {}))))

(defn macro-ns-aliases
"Returns a map of [macro-ns-name-or-alias] to [macro-ns-name] for the given namespace."
[env ns]
(:require-macros (find-ns env ns)))

(defn- expand-refer-map
[m]
(into {} (for [[k v] m] [k (symbol (str v "/" k))])))

(defn referred-vars
"Returns a map of [var-name] to [ns-qualified-var-name] for all referred vars
in the given namespace."
[env ns]
(->> (find-ns env ns)
:uses
expand-refer-map))

(defn referred-macros
"Returns a map of [macro-name] to [ns-qualified-macro-name] for all referred
macros in the given namespace."
[env ns]
(->> (find-ns env ns)
:use-macros
expand-refer-map))

(defn ns-alias
"If sym is an alias to, or the name of, a namespace referred to in ns, returns
the name of the namespace; else returns nil."
[env sym ns]
(get (ns-aliases env ns) sym))

(defn macro-ns-alias
"If sym is an alias to, or the name of, a macro namespace referred to in ns,
returns the name of the macro namespace; else returns nil."
[env sym ns]
(get (macro-ns-aliases env ns) sym))

(defn- public?
[[_ var]]
(not (:private var)))

(defn- named?
[[_ var]]
(not (:anonymous var)))

(defn- foreign-protocol?
[[_ var]]
(and (:impls var)
(not (:protocol-symbol var))))

(defn- macro?
[[_ var]]
(:macro (meta var)))

(defn ns-vars
"Returns a list of the vars declared in the ns."
[env ns]
(->> (find-ns env ns)
:defs
(filter (every-pred named? (complement foreign-protocol?)))
(into {})))

(defn public-vars
"Returns a list of the public vars declared in the ns."
[env ns]
(->> (find-ns env ns)
:defs
(filter (every-pred named? public? (complement foreign-protocol?)))
(into {})))

(defn public-macros
"Given a namespace return all the public var analysis maps. Analagous to
clojure.core/ns-publics but returns var analysis maps not vars.
Inspired by the ns-publics in cljs.analyzer.api."
[env ns]
{:pre [(symbol? ns)]}
#?(:clj (when (and ns (clojure.core/find-ns ns))
(->> (ns-publics ns)
(filter macro?)
(into {})))
:cljs (->> (merge
(get-in env [NSES ns :macros])
(get-in env [NSES ns :defs]))
(remove (fn [[k v]] (:private v)))
(into {}))))

(defn core-vars
"Returns a list of cljs.core vars visible to the ns."
[env ns]
(let [vars (public-vars env 'cljs.core)
excludes (:excludes (find-ns env ns))]
(apply dissoc vars excludes)))

(defn core-macros
"Returns a list of cljs.core macros visible to the ns."
[env ns]
(let [macros (public-macros env #?(:clj 'cljs.core :cljs 'cljs.core$macros))
excludes (:excludes (find-ns env ns))]
(apply dissoc macros excludes)))

(def ^:private language-keywords
#{:require :require-macros :import
:refer :refer-macros :include-macros
:refer-clojure :exclude
:keys :strs :syms
:as :or
:pre :post
:let :when :while
:clj :cljs
:default
:else
:private :doc :author
:gen-class
:keywordize-keys
:req :req-un :opt :opt-un
:args :ret :fn
:const
:arglists :tag :static :added})

(defn keyword-constants
"Returns a list of both keyword constants in the environment and
language specific ones."
[env]
(concat language-keywords (filter keyword? (keys (:cljs.analyzer/constant-table env)))))

;; grabbing directly from cljs.analyzer.api

(defn ns-interns-from-env
"Given a namespace return all the var analysis maps. Analagous to
clojure.core/ns-interns but returns var analysis maps not vars.
Directly from cljs.analyzer.api."
[env ns]
{:pre [(symbol? ns)]}
(merge
(get-in env [NSES ns :macros])
(get-in env [NSES ns :defs])))

(defn sanitize-ns
"Add :ns from :name if missing."
[m]
(-> m
(assoc :ns (or (:ns m) (:name m)))
(update :ns u/namespace-sym)
(update :name u/name-sym)))

(defn var-meta
"Return meta for the var, we wrap it in order to support both JVM and
self-host."
[var]
(cond-> {}
(map? var) (merge var)
(var? var) (-> (merge (meta var))
(update :ns #(cond-> % (u/ns-obj? %) ns-name)))
true sanitize-ns
#?@(:cljs [true (-> (update :ns u/remove-macros)
(update :name u/remove-macros))])))

(defn ns-meta
"Return meta for the var, we wrap it in order to support both JVM and
self-host."
[var]
(cond-> {}
(map? var) (merge var)
(u/ns-obj? var) (merge {:ns (ns-name var)
:name (ns-name var)})
true sanitize-ns
#?@(:cljs [true (-> (update :ns u/remove-macros)
(update :name u/remove-macros))])))

(defn find-symbol-meta
"Given a namespace-qualified var name, gets the analyzer metadata for that
var."
[env sym]
(let [ns (find-ns env (u/namespace-sym sym))]
(some-> (:defs ns)
(get (u/name-sym sym))
var-meta)))

(defn special-meta
"Given a special symbol, gets the analyzer metadata."
[_ sym]
(when-let [meta #?(:clj (or (get @#'cljs.repl/special-doc-map sym)
(get @#'cljs.repl/repl-special-doc-map sym))
:cljs (or (get special/special-doc-map sym)
(get special/repl-special-doc-map sym)))]
(merge {:name sym
:ns 'cljs.core
:special-form true}
meta)))

0 comments on commit 69d85e0

Please sign in to comment.