(ns devtools.munging "This namespace implements various heuristics to map Javascript names back to corresponding ClojureScript names. The functionality here heavily depends on observed ClojureScript compiler and runtime behaviour (fragile!). Answers given by functions in this namespace cannot be perfect because generated Javascript naming schemes produced by ClojureScript compiler were not designed with easy reversibility in mind. We recommend this functionality to be used for presentation in the UI only. The goal here is to provide user with more familiar view of runtime state of her app in most common cases (on best effort basis). Our main weapons in this uneven fight are: 1. munged function names as they appear in Javascript (generated by ClojureScript) 2. we can also analyze function sources accessible via .toString 3. special cljs$core$IFn$_invoke protocol props generated for multi-arity functions We can also cheat and look at runtime state of browser environment to determine some answers about namespaces. If you discovered breakage or a new case which should be covered by this code, please open an issue: https://github.com/binaryage/cljs-devtools/issues" (:refer-clojure :exclude [js-reserved?]) (:require-macros [devtools.munging :refer [get-fast-path-protocol-partitions-count get-fast-path-protocols-lookup-table]]) (:require [clojure.string :as string] [devtools.util :refer-macros [oget oset ocall safe-call]] [goog.object :as gobj]) (:import [goog.string StringBuffer])) (declare collect-fn-arities) (def dollar-replacement "~﹩~") (def max-fixed-arity-to-scan 64) ; -- helpers ---------------------------------------------------------------------------------------------------------------- (defn js-reserved? [x] ; js-reserved? is private for some reason (ocall (oget js/window "cljs" "core") "js_reserved_QMARK_" x)) (defn get-fn-source-safely [f] (try (ocall f "toString") (catch :default _ ""))) (defn get-fn-fixed-arity [f n] (oget f (str "cljs$core$IFn$_invoke$arity$" n))) (defn get-fn-variadic-arity [f] (oget f (str "cljs$core$IFn$_invoke$arity$variadic"))) (defn get-fn-max-fixed-arity [f] (oget f "cljs$lang$maxFixedArity")) (defn get-type-name [t] (let [sb (StringBuffer.) writer (StringBufferWriter. sb)] (try ; we cannot use (type->str f) because it does not work for defrecords as of v1.9.89 ; instead we rely on .cljs$lang$ctorPrWriter which is defined for both deftypes and defrecords ; and it is used here: https://github.com/clojure/clojurescript/blob/cfbefad0b9f2ae9af92ebc2ec211c8472a884ddf/src/main/cljs/cljs/core.cljs#L9173 ; relevant JIRA ticket: http://dev.clojure.org/jira/browse/CLJS-1725 (ocall t "cljs$lang$ctorPrWriter" t writer) (catch :default _ "?")) (-flush writer) (str sb))) (defn char-to-subscript "Given a character with a single digit converts it into a subscript character. Zero chracter maps to unicode 'SUBSCRIPT ZERO' (U+2080)." [char] {:pre [(string? char) (= (count char) 1)]} (let [char-code (ocall (js/String. char) "charCodeAt" 0) ; this is an ugly trick to overcome a V8? bug, char string might not be a real string "object" num-code (- char-code 48) subscript-code (+ 0x2080 num-code)] (ocall js/String "fromCharCode" subscript-code))) (defn make-subscript "Given a subscript number converts it into a string representation consisting of unicode subscript characters (digits)." [subscript] {:pre [(number? subscript)]} (string/join (map char-to-subscript (str subscript)))) (defn char-to-superscript "Given a character with a single digit converts it into a superscript character. Zero chracter maps to unicode 'SUPERSCRIPT ZERO' (U+2070)." [char] {:pre [(string? char) (= (count char) 1)]} (let [char-code (ocall (js/String. char) "charCodeAt" 0) ; this is an ugly trick to overcome a V8? bug, char string might not be a real string "object" num-code (- char-code 48) superscript-code (case num-code ; see https://en.wikipedia.org/wiki/Unicode_subscripts_and_superscripts 1 0x00B9 2 0x00B2 3 0x00B3 (+ 0x2070 num-code))] (ocall js/String "fromCharCode" superscript-code))) (defn make-superscript "Given a superscript number converts it into a string representation consisting of unicode superscript characters (digits)." [superscript] {:pre [(number? superscript)]} (string/join (map char-to-superscript (str superscript)))) ; -- cljs naming conventions ------------------------------------------------------------------------------------------------ (defn cljs-fn-name? "Given a Javascript name answers if the name was likely generated by ClojureScript. We use a simple heuristic here: The name must contain at least two separate dollars because we assume two-segment namespaces." [munged-name] (if (string? munged-name) (some? (re-matches #"^[^$]*\$[^$]+\$.*$" munged-name)))) (defn parse-fn-source "Given a function source code parses out [name args]. Note that both strings are still munged. Suitable for further processing. For exampe for input below the function will return [\"devtools_sample$core$hello\" \"name, unused_param\"]: function devtools_sample$core$hello(name, unused_param){ return [cljs.core.str(\"hello, \"),cljs.core.str(name),cljs.core.str(\"!\")].join(''); } " [fn-source] (if-let [meat (second (re-find #"function\s(.*?)\{" fn-source))] (if-let [match (re-find #"(.*?)\((.*)\)" meat)] (rest match)))) (defn trivial-fn-source? [fn-source] {:pre [(string? fn-source)]} (or (some? (re-matches #"function\s*\(\s*\)\s*\{\s*\}\s*" fn-source)) (some? (re-matches #"function.*\(\)\s*\{\s*\[native code\]\s*\}\s*" fn-source)))) (defn cljs-fn? "Given a Javascript function object returns true if the function looks like a ClojureScript function. Uses various heuristics: 1. must be fn? (is javascript function or satisfies Fn and IFn protocols) 2. and name must be cljs-fn-name? (name can come from f.name or parsed out of function source) 3. or if anonymous function, must be non-trivial" [f] (if (safe-call fn? false f) ; calling fn? on window object could throw for some weird reason (let [name (oget f name)] (if-not (empty? name) (cljs-fn-name? name) (let [fn-source (get-fn-source-safely f)] (let [[name] (parse-fn-source fn-source)] (if-not (empty? name) (cljs-fn-name? name) (not (trivial-fn-source? fn-source))))))))) ; we assume non-trivial anonymous functions to come from cljs ; -- demunging -------------------------------------------------------------------------------------------------------------- (defn dollar-preserving-demunge "Standard cljs.core/demunge is too agresive in replacing dollars. This wrapper function works around it by leaving dollars intact." [munged-name] (-> munged-name (string/replace "$" dollar-replacement) (demunge) (string/replace dollar-replacement "$"))) (defn revert-reserved [s] (or (if-let [m (re-matches #"(.*)\$" s)] (if (js-reserved? (second m)) (second m))) s)) (defn reserved-aware-demunge [munged-name] (-> munged-name (dollar-preserving-demunge) (revert-reserved))) (defn proper-demunge [munged-name] (reserved-aware-demunge munged-name)) (defn proper-arg-demunge [munged-arg-name] (-> munged-arg-name (proper-demunge) (string/replace #"^-(.*)$" "_$1"))) ; leading dash was probably a leading underscore (convention) (defn proper-ns-demunge [munged-ns-name] (-> munged-ns-name (proper-demunge) (string/replace "$" "."))) (defn ns-exists? [ns-module-name] {:pre [(string? ns-module-name)]} (if-let [goog-namespaces (oget js/window "goog" "dependencies_" "nameToPath")] (some? (oget goog-namespaces ns-module-name)))) (defn detect-namespace-prefix "Given a name broken into namespace parts returns [detected-ns remaining-parts], where detected-ns is a string representing longest detected existing namespace and remaining-parts is a vector of remaing input parts not included in the detected-ns concatenation. For given input [\"cljs\" \"core\" \"first\"] returns [\"cljs.core\" [\"first\"]] (asumming cljs.core exists)" [tokens & [ns-detector]] (let [effective-detector (or ns-detector ns-exists?)] (loop [name-tokens [] remaining-tokens tokens] (if (empty? remaining-tokens) ["" name-tokens] (let [ns-name (string/join "." remaining-tokens)] (if (effective-detector ns-name) [ns-name name-tokens] (recur (concat [(last remaining-tokens)] name-tokens) (butlast remaining-tokens)))))))) (defn normalize-arity [arity-tokens] (if-not (empty? arity-tokens) (let [arity (first arity-tokens)] (case arity "variadic" arity (ocall js/window "parseInt" arity 10))))) (defn strip-arity [tokens] (let [[prefix-tokens arity-tokens] (split-with #(not= % "arity") tokens)] [prefix-tokens (normalize-arity (rest arity-tokens))])) (defn parse-protocol [tokens detector] (loop [remaining-tokens tokens name-tokens []] (if (empty? remaining-tokens) [name-tokens] (let [[protocol-ns name-and-method-tokens] (detect-namespace-prefix remaining-tokens detector)] (if (empty? protocol-ns) (recur (rest remaining-tokens) (conj name-tokens (first remaining-tokens))) [name-tokens protocol-ns (first name-and-method-tokens) (rest name-and-method-tokens)]))))) ; we assume protocol names are always a single-token (defn break-munged-name "Given a munged-name from Javascript lands attempts to break it into: [fn-ns fn-name protocol-ns protocol-name protocol-method arity]. Protocol and arity elements are optional. Function elements are always present or \"\". examples for input: cljs$core$rest => ['cljs.core', 'rest'] cljs.core.reduce$cljs$core$IFn$_invoke$arity$3 => ['cljs.core' 'reduce' 'cljs.core' 'IFn' '_invoke' 3]" ([munged-name] (break-munged-name munged-name nil)) ([munged-name ns-detector] (if (empty? munged-name) ["" ""] (let [effective-detector (or ns-detector ns-exists?) tokens (vec (.split munged-name #"[$.]")) [tokens arity] (strip-arity tokens) [fn-ns tokens] (detect-namespace-prefix tokens effective-detector) ; remianing parts contains function name, ; but may be optionally followed by protocol namespace, protocol name and protocol method [fn-name-tokens protocol-ns protocol-name protocol-method-tokens] (parse-protocol tokens effective-detector) fn-name (string/join "$" fn-name-tokens) protocol-method (if protocol-method-tokens (string/join "$" protocol-method-tokens))] [fn-ns fn-name protocol-ns protocol-name protocol-method arity])))) (defn break-and-demunge-name "Given a munged-name from Javascript lands attempts to break it into a namespace part and remaining short name. Then applies appropriate demunging on them and returns ClojureScript versions of the names." ([munged-name] (break-and-demunge-name munged-name nil)) ([munged-name ns-detector] (let [result (break-munged-name munged-name ns-detector) [munged-ns munged-name munged-protocol-ns munged-protocol-name munged-protocol-method arity] result] [(proper-ns-demunge munged-ns) (proper-demunge munged-name) (if munged-protocol-ns (proper-ns-demunge munged-protocol-ns)) (if munged-protocol-name (proper-demunge munged-protocol-name)) (if munged-protocol-method (proper-demunge munged-protocol-method)) arity]))) ; -- fn info ---------------------------------------------------------------------------------------------------------------- (defn parse-fn-source-info "Given function source code tries to retrieve [ns name & args] on best effort basis, where ns is demunged namespace part of the function name (or \"\" if namespace cannot be detected) name is demunged short name (or \"\" if function is anonymous or name cannot be retrieved) args is optional number of demunged argument names. Please note that this function always returns a vector with something. In worst cases [\"\" \"\"]. " [fn-source] (if-let [[munged-name args] (parse-fn-source fn-source)] (let [[ns name] (break-and-demunge-name munged-name) demunged-args (map (comp proper-arg-demunge string/trim) (string/split args #","))] (concat [ns name] demunged-args)) ["" ""])) (defn parse-fn-info "Given Javascript function object tries to retrieve [ns name & args] as in parse-fn-source-info (on best effort basis)." [f] (let [fn-source (get-fn-source-safely f)] (parse-fn-source-info fn-source))) (defn parse-fn-info-deep "Given a Javascript function object tries to retrieve [ns name & args] as in parse-fn-info (on best effort basis). The difference from parse-fn-info is that this function prefers to read args from arities if available. It recurses arbitrary deep following IFn protocol leads. If we hit multi-arity situation in leaf, we don't attempt to list arguments and return ::multi-arity placeholder instead. The reason for reading arities is that it gives more accurate parameter names in some cases. We observed that variadic functions don't always contain original parameter names, but individual IFn arity functions do." [f] (let [fn-info (parse-fn-info f) arities (collect-fn-arities f)] (if (some? arities) (if (> (count arities) 1) (concat (take 2 fn-info) ::multi-arity) (concat (take 2 fn-info) (drop 2 (parse-fn-info-deep (second (first arities)))))) fn-info))) ; -- support for human-readable names --------------------------------------------------------------------------------------- (defn find-index-of-human-prefix "Given a demunged ClojureScript parameter name. Tries to detect human readable part and returns the index where it ends. Returns nil if no prefix can be detected. The idea is to convert macro-generated parameters and other generated names to more friendly names. We observed that param names generated by gensym have prefix followed by big numbers. Other generated names contain two dashes after prefix (originally probably using underscores)." [name] (let [sep-start (.indexOf name "--") num-prefix (count (second (re-find #"(.*?)\d{2,}" name))) finds (filter pos? [sep-start num-prefix])] (if-not (empty? finds) (apply min finds)))) (defn humanize-name "Given a name and intermediate state. Convert name to a human readable version by keeping human readable prefix with optional subscribt postfix and store it in ::result. Subscript number is picked based on state. State keeps track of previously assigned subscripts. Returns a new state." [state name] (let [index (find-index-of-human-prefix name) prefix (if (> index 0) (.substring name 0 index) name)] (if-let [subscript (get state prefix)] (-> state (update ::result conj (str prefix (make-subscript subscript))) (update prefix inc)) (-> state (update ::result conj prefix) (assoc prefix 2))))) (defn humanize-names "Given a list of names, returns a list of human-readable versions of those names. It detects human-readable prefix using a simple heuristics. When names repeat it assigns simple subscripts starting with 2. Subscripts are assigned left-to-right. Given [\"p--a\" \"p--b\" \"x\" \"p--c\"] returns [\"p\" \"p₂\" \"x\" \"p₃\"]" [names] (with-meta (::result (reduce humanize-name {::result []} names)) (meta names))) ; -- arities ---------------------------------------------------------------------------------------------------------------- (defn collect-fn-fixed-arities [f max-arity] (loop [arity 0 collection {}] (if (> arity max-arity) collection (recur (inc arity) (if-let [arity-fn (get-fn-fixed-arity f arity)] (assoc collection arity arity-fn) collection))))) (defn collect-fn-variadic-arities [f] (if-let [variadic-arity (get-fn-variadic-arity f)] {::variadic variadic-arity})) (defn review-arity [[arity arity-fn]] (let [sub-arities (collect-fn-arities arity-fn)] (if (::variadic sub-arities) [::variadic arity-fn] [arity arity-fn]))) (defn review-arities "Some arities can be marked as fixed arity but in fact point to a variadic-arity function. We want to detect this case and turn such improperly categorized arities to ::variadic." [arities] (if (::variadic arities) arities (into {} (map review-arity arities)))) (defn collect-fn-arities "Given a Javascript function object, tries to inspect known arity properties generated by ClojureScript compiler and collects all available arity functions into a map. Arities are keyed by arity count and variadic arity gets ::variadic key." [f] (let [max-fixed-arity (get-fn-max-fixed-arity f) fixed-arities (collect-fn-fixed-arities f (or max-fixed-arity max-fixed-arity-to-scan)) ; we cannot rely on cljs$lang$maxFixedArity when people implement IFn protocol by hand variadic-arities (collect-fn-variadic-arities f) arities (review-arities (merge fixed-arities variadic-arities))] (if-not (empty? arities) arities))) ; -- args lists ------------------------------------------------------------------------------------------------------------- (defn arity-keywords-comparator "::variadic goes last, other keywords compare by name." [x y] (cond (= ::variadic x) 1 (= ::variadic y) -1 :else (compare (name x) (name y)))) (defn arities-key-comparator "numbers go first (ordered), then keywords (ordered by name), and then ::variadic sticks last" [x y] (let [kx? (keyword? x) ky? (keyword? y)] (cond (and kx? ky?) (arity-keywords-comparator x y) kx? 1 ky? -1 :else (compare x y)))) (defn arities-to-args-lists* [arities] (let [sorted-keys (sort arities-key-comparator (keys arities)) sorted-fns (map #(get arities %) sorted-keys) sorted-infos (map parse-fn-info-deep sorted-fns) sorted-args-lists (map #(drop 2 %) sorted-infos)] (if (= (last sorted-keys) ::variadic) (concat (butlast sorted-args-lists) [(vary-meta (last sorted-args-lists) assoc ::variadic true)]) sorted-args-lists))) (defn arities-to-args-lists "Given a map of arity functions. Tries to parse individual functions and prepare an arguments list for each arity. Returned list of arguments list is sorted by arity count, variadic arity goes last if available. The function also optionally humanizes argument names in each arguments list if requested." [arities & [humanize?]] (let [args-lists (arities-to-args-lists* arities)] (if humanize? (map humanize-names args-lists) args-lists))) ; -- UI presentation -------------------------------------------------------------------------------------------------------- (defn args-lists-to-strings "Converts a list of arguments lists into a list of strings suitable for UI presentation." [args-lists spacer-symbol multi-arity-symbol rest-symbol] (let [string-mapper (fn [arg] (case arg ::multi-arity multi-arity-symbol arg)) printer (fn [args-list] (let [variadic? (::variadic (meta args-list)) args-strings (map string-mapper args-list)] (str (string/join spacer-symbol (butlast args-strings)) (if variadic? rest-symbol spacer-symbol) (last args-strings))))] (->> args-lists (map printer) (map string/trim)))) (defn extract-arities [f humanize? spacer-symbol multi-arity-symbol rest-symbol] (-> (or (collect-fn-arities f) {:naked f}) (arities-to-args-lists humanize?) (args-lists-to-strings spacer-symbol multi-arity-symbol rest-symbol))) (defn common-protocol? [protocol-ns protocol-name] (and (= protocol-ns "cljs.core") (= protocol-name "IFn"))) (defn present-fn-part [fn-ns fn-name include-ns?] (str (if (and include-ns? (not (empty? fn-ns))) (str fn-ns "/")) fn-name)) (defn present-protocol-part [protocol-ns protocol-name protocol-method include-protocol-ns?] (str (if include-protocol-ns? protocol-ns) (if-not (empty? protocol-name) (str (if include-protocol-ns? ".") protocol-name)) (if-not (empty? protocol-method) (str (if (or include-protocol-ns? (not (empty? protocol-name))) ":") protocol-method)))) (defn present-function-name "Given javascript function name tries to present it as plain string for display in UI on best effort basis." [munged-name options] (let [{:keys [include-ns? include-protocol-ns? silence-common-protocols? ns-detector]} options [fn-ns fn-name protocol-ns protocol-name protocol-method arity] (break-and-demunge-name munged-name ns-detector) arity-str (if (some? arity) (if (= arity "variadic") "\u207F" ; 'SUPERSCRIPT LATIN SMALL LETTER N' (U+207F) (make-superscript arity)))] (if (empty? fn-name) munged-name (let [fn-part (present-fn-part fn-ns fn-name include-ns?) protocol-part (if (and protocol-ns (not (and silence-common-protocols? (common-protocol? protocol-ns protocol-name)))) (present-protocol-part protocol-ns protocol-name protocol-method include-protocol-ns?))] (str (or protocol-part fn-part) arity-str (if protocol-part (str " (" fn-part ")"))))))) ; -- types ------------------------------------------------------------------------------------------------------------------ (defn get-basis [f] (ocall f "getBasis")) (defn parse-constructor-info "Given a Javascript constructor function tries to retrieve [ns name basis]. Returns nil if not a cljs type." [f] (if (and (goog/isObject f) (oget f "cljs$lang$type")) (let [type-name (get-type-name f) parts (.split type-name #"/") basis (safe-call get-basis [] f)] (assert (<= (count parts) 2)) (while (< (count parts) 2) (.unshift parts nil)) (conj (vec parts) basis)))) ; -- protocols -------------------------------------------------------------------------------------------------------------- (defn protocol-path [protocol-selector] (string/split protocol-selector #"\.")) (defn get-protocol-object [protocol-selector] (loop [obj js/window path (protocol-path protocol-selector)] (if (empty? path) obj (if (goog/isObject obj) (recur (oget obj (first path)) (rest path)))))) (defn protocol-exists? [protocol-selector] (some? (get-protocol-object protocol-selector))) (defn get-protocol-selector [key] (if-let [m (re-matches #"(.*)\$$" key)] (if-not (string/includes? key "cljs$lang$protocol_mask$partition") (let [protocol-selector (string/replace (second m) "$" ".")] (if (protocol-exists? protocol-selector) protocol-selector))))) (defn demunge-protocol-selector [protocol-selector] (let [parts (map proper-demunge (protocol-path protocol-selector)) _ (assert (>= (count parts) 2) (str "expected protocol selector to contain at least one dot: '" protocol-selector "'")) ns (string/join "." (butlast parts)) name (last parts)] [ns name protocol-selector])) (def fast-path-protocols-lookup-table (get-fast-path-protocols-lookup-table)) (defn key-for-protocol-partition [partition] (str "cljs$lang$protocol_mask$partition" partition "$")) (defn scan-fast-path-protocols-partition [obj partition] {:pre [(number? partition)]} (let [partition-key (key-for-protocol-partition partition) partition-bits (or (oget obj partition-key) 0)] (if (> partition-bits 0) (let [lookup-table (get fast-path-protocols-lookup-table partition) _ (assert (map? lookup-table) (str "fast-path-protocols-lookup-table does not contain lookup table for partition " partition)) * (fn [accum [bit protocol]] (if (zero? (bit-and partition-bits bit)) accum (conj accum protocol)))] (reduce * [] lookup-table))))) (defn scan-fast-path-protocols [obj] (apply concat (map (partial scan-fast-path-protocols-partition obj) (range (get-fast-path-protocol-partitions-count))))) (defn scan-slow-path-protocols [obj] (let [keys (gobj/getKeys obj) selectors (keep get-protocol-selector keys)] (map demunge-protocol-selector selectors))) (defn make-protocol-descriptor [ns name selector fast?] {:ns ns :name name :selector selector :fast? fast?}) (defn convert-to-protocol-descriptor [fast? [ns name selector]] (make-protocol-descriptor ns name selector fast?)) (defn protocol-descriptors-comparator [a b] (compare (:name a) (:name b))) (defn scan-protocols [obj] (let [fast-path-protocols (map (partial convert-to-protocol-descriptor true) (scan-fast-path-protocols obj)) slow-path-protocols (map (partial convert-to-protocol-descriptor false) (scan-slow-path-protocols obj)) all-protocols (concat fast-path-protocols slow-path-protocols)] (sort protocol-descriptors-comparator all-protocols))) (defn collect-protocol-methods [obj protocol-selector] (let [key-prefix (string/replace protocol-selector #"\." "\\$") pattern (re-pattern (str "^" key-prefix "\\$(.*)\\$arity\\$(\\d+)$")) all-keys (gobj/getKeys obj) matches (keep (partial re-matches pattern) all-keys) methods (group-by second matches) match-to-arity (fn [match] (let [arity (nth match 2)] (ocall js/window "parseInt" arity 10))) match-arity-comparator (fn [a b] (compare (match-to-arity a) (match-to-arity b))) post-process (fn [[munged-name matches]] (let [name (proper-demunge munged-name) sorted-matches (sort match-arity-comparator matches) sorted-fns (map #(oget obj (first %)) sorted-matches)] [name sorted-fns])) by-name-comparator (fn [a b] (compare (first a) (first b)))] ; TODO: he we could be able to retrieve parameter lists from protocol definition methods ; parameter names there are usually more consistent than parameters picked by protocol implementors (sort by-name-comparator (map post-process methods))))