From af69f12630854284dbfcd88bb1d3badff74e7808 Mon Sep 17 00:00:00 2001
From: Sean Corfield <sean@corfield.org>
Date: Fri, 25 Mar 2022 21:48:00 -0700
Subject: [PATCH] address #398 (needs docs)

---
 CHANGELOG.md                     |  1 +
 src/honey/sql.cljc               |  6 +++--
 src/honey/sql/pg_json.cljc       | 40 ++++++++++++++++++++++++++++++++
 test/honey/sql/pg_json_test.cljc | 39 +++++++++++++++++++++++++++++++
 4 files changed, 84 insertions(+), 2 deletions(-)
 create mode 100644 src/honey/sql/pg_json.cljc
 create mode 100644 test/honey/sql/pg_json_test.cljc

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 647dae5..7c1fa60 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,6 +1,7 @@
 # Changes
 
 * 2.2.next in progress
+  * Address [#398](https://github.com/seancorfield/honeysql/issues/398) by adding `honey.sql.pg-json` namespace that registers PostgreSQL JSON operators and provides symbolic names for "unwritable" operators (that contain `@`).
   * Fix [#387](https://github.com/seancorfield/honeysql/issues/387) again.
   * Update CI to reflect Clojure 1.11 release (master -> 1.11; new master is 1.12).
   * Update `build-clj` to v0.8.0.
diff --git a/src/honey/sql.cljc b/src/honey/sql.cljc
index 1b4735f..721fb34 100644
--- a/src/honey/sql.cljc
+++ b/src/honey/sql.cljc
@@ -227,9 +227,11 @@
   becomes a `KEBAB CASE` (uppercase) string with hyphens replaced
   by spaces, e.g., `:insert-into` => `INSERT INTO`.
 
-  Any namespace qualifier is ignored."
+  Any namespace qualifier is ignored.
+
+  Any ? is escaped to ??."
   [k]
-  (let [n (name k)]
+  (let [n (str/replace (name k) "?" "??")]
     (if (= \' (first n))
       (format-entity (keyword (subs n 1 (count n))))
       (-> n (dehyphen) (upper-case)))))
diff --git a/src/honey/sql/pg_json.cljc b/src/honey/sql/pg_json.cljc
new file mode 100644
index 0000000..0ad2899
--- /dev/null
+++ b/src/honey/sql/pg_json.cljc
@@ -0,0 +1,40 @@
+;; copyright (c) 2022 sean corfield, all rights reserved
+
+(ns honey.sql.pg-json
+  "Register all the PostgreSQL JSON/JSONB operators
+  and provide convenient Clojure names for those ops
+  that cannot be written as keywords or symbols directly."
+  (:require [honey.sql :as sql]))
+
+;; see https://www.postgresql.org/docs/current/functions-json.html
+
+;; :->
+;; :->>
+;; :#>
+;; :#>>
+(def at> "The @> operator." (keyword "@>"))
+(def <at "The <@ operator." (keyword "<@"))
+;; :?
+;; :?|
+;; :?&
+;; :||
+;; :-
+;; :#-
+(def at? "The @? operator." (keyword "@?"))
+(def atat "The @@ operator." (keyword "@@"))
+
+(sql/register-op! :->)
+(sql/register-op! :->>)
+(sql/register-op! :#>)
+(sql/register-op! :#>>)
+(sql/register-op! at>)
+(sql/register-op! <at)
+(sql/register-op! :?)
+(sql/register-op! :?|)
+(sql/register-op! :?&)
+;; these are already known operators:
+;(sql/register-op! :||)
+;(sql/register-op! :-)
+(sql/register-op! :#-)
+(sql/register-op! at?)
+(sql/register-op! atat)
diff --git a/test/honey/sql/pg_json_test.cljc b/test/honey/sql/pg_json_test.cljc
new file mode 100644
index 0000000..003541d
--- /dev/null
+++ b/test/honey/sql/pg_json_test.cljc
@@ -0,0 +1,39 @@
+;; copyright (c) 2020-2021 sean corfield, all rights reserved
+
+(ns honey.sql.pg-json-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [honey.sql :as sql]
+            [honey.sql.pg-json :as sut]))
+
+(deftest pg-op-tests
+  (testing "built-in ops"
+    (is (= ["SELECT a || b AS x"]
+           (sql/format {:select [[[:|| :a :b] :x]]})))
+    (is (= ["SELECT a - b AS x"]
+           (sql/format {:select [[[:- :a :b] :x]]}))))
+  (testing "writable ops"
+    (is (= ["SELECT a -> b AS x"]
+           (sql/format {:select [[[:-> :a :b] :x]]})))
+    (is (= ["SELECT a ->> b AS x"]
+           (sql/format {:select [[[:->> :a :b] :x]]})))
+    (is (= ["SELECT a #> b AS x"]
+           (sql/format {:select [[[:#> :a :b] :x]]})))
+    (is (= ["SELECT a #>> b AS x"]
+           (sql/format {:select [[[:#>> :a :b] :x]]})))
+    (is (= ["SELECT a ?? b AS x"]
+           (sql/format {:select [[[:? :a :b] :x]]})))
+    (is (= ["SELECT a ??| b AS x"]
+           (sql/format {:select [[[:?| :a :b] :x]]})))
+    (is (= ["SELECT a ??& b AS x"]
+           (sql/format {:select [[[:?& :a :b] :x]]})))
+    (is (= ["SELECT a #- b AS x"]
+           (sql/format {:select [[[:#- :a :b] :x]]}))))
+  (testing "named ops"
+    (is (= ["SELECT a @> b AS x"]
+           (sql/format {:select [[[sut/at> :a :b] :x]]})))
+    (is (= ["SELECT a <@ b AS x"]
+           (sql/format {:select [[[sut/<at :a :b] :x]]})))
+    (is (= ["SELECT a @?? b AS x"]
+           (sql/format {:select [[[sut/at? :a :b] :x]]})))
+    (is (= ["SELECT a @@ b AS x"]
+           (sql/format {:select [[[sut/atat :a :b] :x]]})))))