sexpr on tag metadata now expands to long form (#282)

We also now throw when trying to sexpr invalid metadata. Closes #280
clj-commons · Jun 25, 2024 · 3b8ac40 · 3b8ac40
1 parent 31ad382
commit 3b8ac40
Show file tree

Hide file tree

Showing 4 changed files with 124 additions and 4 deletions.
diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc
@@ -19,9 +19,13 @@ A release with known breaking changes is marked with:
 //   (adjust these in publish.clj as you see fit)
 === Unreleased
 
-* bump `org.clojure/tools.reader` to version `1.4.2`
+* bump `org.clojure/tools.reader` to version `1.4.2` (@lread)
+* `sexpr` now 1) expands tag metadata to its long form 2) throws on invalid metadata
+https://github.com/clj-commons/rewrite-clj/issues/280[#280]
+(@lread)
 * `rewrite-clj.paredit/barf-forward` on zipper created with `:track-position? true` now correctly barfs when current node has children
 https://github.com/clj-commons/rewrite-clj/issues/245[#245]
+(@lread, thanks for the issue @p4ulcristian!)
 
 === v1.1.47 - 2023-03-25 [[v1.1.47]]
 

diff --git a/doc/01-user-guide.adoc b/doc/01-user-guide.adoc
@@ -792,6 +792,48 @@ But when converting to a Clojure form, duplicate values in a set are not valid C
 ;; => #{:b :a}
 ----
 
+[[invalid-metadata]]
+=== Invalid Metadata
+Clojure can read metadata that is any of:
+
+[%autowidth]
+|===
+| Type | Example | Equivalent Long Form
+
+| map
+a|`^{:a 1 :b 2} foo`
+a|`^{:a 1 :b 2} foo`
+
+| keyword
+a| `^:private bar`
+a| `^{:private true} bar`
+
+| symbol
+a| `^SomeType baz`
+a| `^{:tag SomeType} baz`
+
+| string
+a|`^"SomeType" qux`
+a| `^{:tag "SomeType"} qux`
+
+|===
+
+Rewrite-clj will happily read and write metdata that is technically invalid.
+When you `sexpr` a metadata node you are also effectively converting it to its long form.
+If you try to `sexpr` a node with invalid metadata you will get an exception:
+
+//#:test-doc-blocks {:reader-cond :clj}
+[source,clojure]
+----
+(try
+  (-> "^(bad metadata) foobar"
+      z/of-string
+      z/sexpr)
+  (catch Throwable e
+    (.getMessage e)))
+;; => "Metadata must be a map, keyword, symbol or string"
+----
+
 [#sexpr-nuances]
 == Sexpr Nuances
 
@@ -863,8 +905,8 @@ Both the zip and node APIs include `sexpr-able?` to check if sexpr is supported
 ====
 `sexpr-able?` only looks at the current node element type. This means that `sexpr` will still throw when:
 
-1. called on a node with an element type that is `sepxr-able?` but, for whatever reason, has a child node that fails to `sexpr`, see link:#unbalanced-maps[unbalanced maps].
-2. called directly on an link:#unbalanced-maps[unbalanced maps].
+1. called on a node with an element type that is `sepxr-able?` but, for whatever reason, has a child node that fails to `sexpr`, see link:#unbalanced-maps[unbalanced maps] and link:#invalid-metadata[invalid metadata].
+2. called directly on an link:#unbalanced-maps[unbalanced maps] or node with link:#invalid-metadata[invalid metadata].
 ====
 
 [source, clojure]

diff --git a/src/rewrite_clj/node/meta.cljc b/src/rewrite_clj/node/meta.cljc
@@ -16,7 +16,12 @@
     (let [[mta data] (node/sexprs children opts)]
       (assert (interop/meta-available? data)
               (str "cannot attach metadata to: " (pr-str data)))
-      (vary-meta data merge (if (map? mta) mta {mta true}))))
+      (vary-meta data merge
+                 (cond (map? mta) mta
+                       (keyword? mta) {mta true}
+                       (symbol? mta) {:tag mta}
+                       (string? mta) {:tag mta}
+                       :else (throw (ex-info "Metadata must be a map, keyword, symbol or string" {}))))))
   (length [_node]
     (+ (count prefix) (node/sum-lengths children)))
   (string [_node]

diff --git a/test/rewrite_clj/parser_test.cljc b/test/rewrite_clj/parser_test.cljc
@@ -270,6 +270,75 @@
     (is (= s (node/string n)))
     (is (= 's (node/sexpr target-sym)))))
 
+(deftest t-parsing-tag-symbol-metadata
+  (doseq [[s expected-node]
+          [["^MyType foo"         (node/meta-node [(node/token-node 'MyType)
+                                                   (node/spaces 1)
+                                                   (node/token-node 'foo)])]
+           ["^{:tag MyType} foo"  (node/meta-node
+                                    [(node/map-node [(node/keyword-node :tag)
+                                                     (node/spaces 1)
+                                                     (node/token-node 'MyType)])
+                                     (node/spaces 1)
+                                     (node/token-node 'foo)])]
+           ["#^MyType foo"        (node/raw-meta-node [(node/token-node 'MyType)
+                                                       (node/spaces 1)
+                                                       (node/token-node 'foo)])]
+           ["#^{:tag MyType} foo" (node/raw-meta-node
+                                    [(node/map-node [(node/keyword-node :tag)
+                                                     (node/spaces 1)
+                                                     (node/token-node 'MyType)])
+                                     (node/spaces 1)
+                                     (node/token-node 'foo)])]]
+
+          :let [n (p/parse-string s)]]
+    (is (= expected-node n) s)
+    (is (= s (node/string n)))
+    (is (= 'foo (node/sexpr n)) s)
+    (is (= {:tag 'MyType} (meta (node/sexpr n))) s)))
+
+(deftest t-parsing-tag-string-metadata
+  (doseq [[s expected-node]
+          [["^\"MyType\" foo"         (node/meta-node [(node/string-node "MyType")
+                                                       (node/spaces 1)
+                                                       (node/token-node 'foo)])]
+           ["^{:tag \"MyType\"} foo"  (node/meta-node
+                                        [(node/map-node [(node/keyword-node :tag)
+                                                         (node/spaces 1)
+                                                         (node/string-node "MyType")])
+                                         (node/spaces 1)
+                                         (node/token-node 'foo)])]
+           ["#^\"MyType\" foo"        (node/raw-meta-node [(node/string-node "MyType")
+                                                           (node/spaces 1)
+                                                           (node/token-node 'foo)])]
+           ["#^{:tag \"MyType\"} foo" (node/raw-meta-node
+                                        [(node/map-node [(node/keyword-node :tag)
+                                                         (node/spaces 1)
+                                                         (node/string-node "MyType")])
+                                         (node/spaces 1)
+                                         (node/token-node 'foo)])]]
+
+          :let [n (p/parse-string s)]]
+    (is (= expected-node n) s)
+    (is (= s (node/string n)))
+    (is (= 'foo (node/sexpr n)) s)
+    (is (= {:tag "MyType"} (meta (node/sexpr n))) s)))
+
+(deftest t-parsing-invalid-metadata
+  (let [s "^(list not valid) foo"
+        n (p/parse-string s)]
+    (is (= (node/meta-node [(node/list-node [(node/token-node 'list)
+                                             (node/spaces 1)
+                                             (node/token-node 'not)
+                                             (node/spaces 1)
+                                             (node/token-node 'valid)])
+                            (node/spaces 1)
+                            (node/token-node 'foo)])
+           n))
+    (is (= s (node/string n)))
+    (is (thrown-with-msg? ExceptionInfo #"Metadata must be a map, keyword, symbol or string"
+                          (node/sexpr n)))))
+
 (deftest t-parsing-reader-macros
   (are [?s ?t ?children]
        (let [n (p/parse-string ?s)]