1616(def node-child second )
1717(def ^:private raw-node-children rest )
1818
19- ; ; -------------------
20- ; ; Transformations
21- ; ; -------------------
22-
2319(defn- remove-whitespaces
2420 " Drop whitespaces, comments and discarded forms from a sequence of nodes."
2521 [xs]
2622 (remove #(#{:whitespace :comment :discard } (node-type %)) xs))
2723
28- (defn- remove-whitespace*
29- " Remove a specific node from a tree if it's a whitespace. get-fn takes the tree's children and return the node.
30- remove-fn takes the children and return them without that node."
31- [tree get-fn remove-fn]
32- (let [children (raw-node-children tree)
33- node (get-fn children)]
34- (if (= :whitespace (node-type node))
35- (cons (first tree) (remove-fn children))
36- tree)))
37-
38- (defn- remove-trailing-whitespace
39- " Remove the trailing whitespace node of a tree, if any."
40- [tree]
41- (remove-whitespace* tree last butlast))
42-
43- (defn- remove-leading-whitespace
44- " Remove the leading whitespace node of a tree, if any."
45- [tree]
46- (remove-whitespace* tree first rest))
47-
48- (defn compact-whitespaces
49- " Transform a tree by 'compacting' its whitespaces: all newlines and sequences of whitespaces are replaced
50- by a single whitespace. Comments are removed as well."
51- [tree]
52- (->> tree
53- (postwalk
54- (fn [node]
55- (if (tree-node? node)
56- (case (node-type node)
57- :comment nil
58- :whitespace (let [s (node-child node)]
59- (if (or (= \newline (first s))
60- (< 1 (count s)))
61- '(:whitespace " "
62- node))
63- (->> node
64- (remove nil?)
65- remove-leading-whitespace
66- remove-trailing-whitespace))
67- node)))
68- remove-leading-whitespace
69- remove-trailing-whitespace))
70-
7124(defn node-children
7225 " Return non-whitespace node children."
7326 [node]
7730; ; Wildcards
7831; ; -------------------
7932
80- (def ^{:dynamic true
81- :doc " Wildcard symbol used to represent any single expression in a pattern.
82- This must be a valid Clojure symbol.
83- It is also used as a prefix for typed wildcards. For example, if this is set to
84- $ (the default), $string represents any single string expression; $list any
85- single list expression; etc." }
86- *wildcard-expression*
87- " $"
88-
89- (def ^{:dynamic true
90- :doc " Wildcard symbol used to represent any number of expressions
91- in a pattern, including zero. This must be a valid Clojure symbol." }
92- *wildcard-expressions*
93- " $&"
94-
95- (defn wildcard-expression?
96- " Test if a node is an expression wildcard symbol."
97- [node]
98- (= (list :symbol *wildcard-expression*)
99- node))
100-
101- (defn wildcard-expressions?
102- " Test if a node is an expressions wildcard symbol."
103- [node]
104- (= (list :symbol *wildcard-expressions*)
105- node))
106-
10733(def ^:private
10834 types
10935 ; ; https://github.com/carocad/parcera/blob/d6b28b1058ef2af447a9452f96c7b6053e59f613/src/parcera/core.cljc#L26
@@ -130,15 +56,88 @@ in a pattern, including zero. This must be a valid Clojure symbol."}
13056 " vector"
13157 " var-quote"
13258
133- (defn typed-wildcard-expression?
134- " Test if a node is an typed expression wildcard symbol."
59+ (def wildcard-prefix " $"
60+ (def multiple-suffix " &"
61+
62+ (defn wildcard?
63+ " Test if a node is a wildcard. This doesn’t check if it's a valid one."
13564 [node]
13665 (and (pattern? node)
13766 (= :symbol (node-type node))
138- (let [s (node-child node)]
139- (str/starts-with? s *wildcard-expression*)
140- (contains? types (subs s 1 )))))
67+ (str/starts-with? (node-child node) wildcard-prefix)))
14168
142- (defn ->typed-wildcard
143- [typ]
144- (str *wildcard-expression* typ))
69+ (defn multi-wildcard?
70+ " Test if a node is a multiple-expressions wildcard. This doesn’t check if its type (if any) is valid."
71+ [node]
72+ (and (wildcard? node)
73+ (str/ends-with? (node-child node) multiple-suffix)))
74+
75+ (defn node-wildcard
76+ " Given a node for which `(wildcard? node)` is true, return a map describing the wildcard if it’s valid."
77+ [node]
78+ (let [s (node-child node)
79+ multiple? (str/ends-with? s multiple-suffix)
80+ wildcard-type (subs s 1 (cond-> (count s) multiple? dec))]
81+ (cond
82+ (= " "
83+ {:node-type :_all
84+ :multiple? multiple?}
85+
86+ (contains? types wildcard-type)
87+ {:node-type (keyword (str/replace wildcard-type #"-" " _"
88+ :multiple? multiple?})))
89+
90+ ; ; -------------------
91+ ; ; Transformations
92+ ; ; -------------------
93+
94+ (defn- remove-whitespace*
95+ " Remove a specific node from a tree if it's a whitespace. get-fn takes the tree's children and return the node.
96+ remove-fn takes the children and return them without that node."
97+ [tree get-fn remove-fn]
98+ (let [children (raw-node-children tree)
99+ node (get-fn children)]
100+ (if (= :whitespace (node-type node))
101+ (cons (first tree) (remove-fn children))
102+ tree)))
103+
104+ (defn- remove-trailing-whitespace
105+ " Remove the trailing whitespace node of a tree, if any."
106+ [tree]
107+ (remove-whitespace* tree last butlast))
108+
109+ (defn- remove-leading-whitespace
110+ " Remove the leading whitespace node of a tree, if any."
111+ [tree]
112+ (remove-whitespace* tree first rest))
113+
114+ (defn- postwalk-tree
115+ " Equivalent of postwalk that only calls f on tree nodes."
116+ [f tree]
117+ (postwalk
118+ (fn [node]
119+ (if (tree-node? node)
120+ (f node)
121+ node))
122+ tree))
123+
124+ (defn compact-whitespaces
125+ " Transform a tree by 'compacting' its whitespaces: all newlines and sequences of whitespaces are replaced
126+ by a single whitespace. Comments are removed as well."
127+ [tree]
128+ (->> tree
129+ (postwalk-tree
130+ (fn [node]
131+ (case (node-type node)
132+ :comment nil
133+ :whitespace (let [s (node-child node)]
134+ (if (or (= \newline (first s))
135+ (< 1 (count s)))
136+ '(:whitespace " "
137+ node))
138+ (->> node
139+ (remove nil?)
140+ remove-leading-whitespace
141+ remove-trailing-whitespace))))
142+ remove-leading-whitespace
143+ remove-trailing-whitespace))
0 commit comments