Multi-statement UX (#64)

* rejig the UI

* multiple statements

* use pgwire to run SQL (what used to be :sql/v1)

* use consistent spacing

* remove unneeded divs

* stop adding default query on reload

* correctly display results - do not show transaction begin/commit results

* fix tests

* fix init, rename var

* missing key on error elem and incorrect default case

* enable queries mixed with TXs

* separate DMLs from queries, rollback after fail, accommodate results in the UI

* unify XTQL results

* statement+multi semis

* better handling of semi-colons within strings

* move X (clear results) button, allow rows to flex for narrow screens

---------

Co-authored-by: Michal Pisanko <[email protected]>

Author: refset

src/clj/xt_play/handler.clj

@@ -38,11 +38,11 @@
 
 (s/def ::system-time (s/nilable string?))
 (s/def ::txs string?)
-(s/def ::tx-batches (s/coll-of (s/keys :req-un [::system-time ::txs])))
-(s/def ::query string?)
+(s/def ::query (s/nilable string?))
+(s/def ::tx-batches (s/coll-of (s/keys :req-un [::system-time ::txs] :opt-un [::query])))
 (s/def ::tx-type #{"sql-v2" "xtql" "sql"})
 (s/def ::db-run (s/keys :req-un [::tx-batches ::query]))
-(s/def ::beta-db-run (s/keys :req-un [::tx-batches ::query ::tx-type]))
+(s/def ::beta-db-run (s/keys :req-un [::tx-batches ::tx-type]))
 
 (defn- handle-client-error [ex _]
   {:status 400
@@ -97,7 +97,7 @@
              :handler #'docs-run-handler}}]
 
     ["/beta-db-run"
-     {:post {:summary "Run transactions + a query"
+     {:post {:summary "Run statements"
              :parameters {:body ::beta-db-run}
              :handler #'run-handler}}]
 

src/clj/xt_play/main.clj

@@ -13,3 +13,6 @@
 (defn -main [& _args]
   (ig/init system)
   @(delay))
+
+(comment
+  (-main))

src/clj/xt_play/transactions.clj

@@ -6,31 +6,72 @@
             [xt-play.util :as util]
             [xt-play.xtdb :as xtdb]))
 
-(defn- encode-txs [tx-type txs]
+(defn- encode-txs [tx-type query? txs]
   (case (keyword tx-type)
-    :sql (if (string? txs)
+    :sql (if (and (not query?)
+                  (string? txs))
            (->> (str/split txs #";")
                 (remove str/blank?)
                 (map #(do [:sql %]))
                 (vec))
            txs)
-    :xtql (util/read-edn (str "[" txs "]"))
+    :xtql (util/read-edn (if query? txs (str "[" txs "]")))
     ;;else
     txs))
 
+(defn- dml? [statement]
+  (when statement
+    (let [upper-st (str/upper-case statement)]
+      (or (str/includes? upper-st "INSERT")
+          (str/includes? upper-st "UPDATE")
+          (str/includes? upper-st "DELETE")
+          (str/includes? upper-st "ERASE")
+          (str/includes? upper-st "MERGE")
+          (str/includes? upper-st "PATCH")))))
+
+(defn split-sql [sql]
+  (loop [chars (seq sql) current [] statements [] in-string? false escape? false]
+    (if (empty? chars)
+      (conj statements (apply str current))
+      (let [c (first chars)
+            rest-chars (rest chars)]
+        (cond
+          (and (= c \') (not escape?))
+          (recur rest-chars (conj current c) statements (not in-string?) false)
+
+          (and in-string? (= c \\))
+          (recur rest-chars (conj current c) statements in-string? (not escape?))
+
+          (and (= c \;) (not in-string?))
+          (recur rest-chars [] (conj statements (apply str current)) in-string? false)
+
+          :else
+          (recur rest-chars (conj current c) statements in-string? false))))))
+
 (defn- prepare-statements
   "Takes a batch of transactions and prepares the jdbc execution args to
-  be run sequentially"
+  be run sequentially. It groups statements by type and wraps DMLs in transactions if system time specified."
   [tx-batches]
   (for [{:keys [txs system-time]} tx-batches]
     (remove nil?
-            (concat
-             (when system-time
-               [[(format "BEGIN AT SYSTEM_TIME TIMESTAMP '%s'" system-time)]])
-             (mapv (fn [q] (vector (str q ";")))
-                   (str/split txs #"\s*;\s*"))
-             (when system-time
-               [["COMMIT"]])))))
+            (when txs
+              (let [statements (split-sql txs)
+                    by-type (partition-by dml? statements)]
+                (log/warn "by-type" by-type)
+                (mapcat
+                 (fn [grp]
+                   (let [dmls? (dml? (first grp))]
+                     (concat
+                      (when (and dmls? system-time)
+                        [[(format "BEGIN AT SYSTEM_TIME TIMESTAMP '%s'" system-time)]])
+                      (vec
+                       (keep (fn [q] (when-not (empty? q)
+                                       [(str/trim q)]))
+                             grp))
+                      (when (and dmls? system-time)
+                        [["COMMIT"]]))))
+                 by-type)
+                )))))
 
 (defn format-system-time [s]
   (when s (read-instant-date s)))
@@ -54,42 +95,82 @@
      (mapv PG->clj row))
    result))
 
-(defn- run!-tx [node tx-type tx-batches query]
+(defn- detect-xtql-queries [batch]
+  (if (:query batch)
+    batch
+    (if (and (string? (:txs batch))
+             (re-matches #"(?i)^\s*(\(->)?\s*\((from|unify|rel).+" (:txs batch)))
+      (assoc batch :query true)
+      batch)))
+
+(defn- run!-tx [node tx-type tx-batches]
   (let [tx-batches (->> tx-batches
+                        (map detect-xtql-queries)
                         (map #(update % :system-time format-system-time))
-                        (map #(update % :txs (partial encode-txs tx-type))))]
-    (doseq [{:keys [system-time txs] :as batch} tx-batches]
-      (log/info tx-type "running batch: " batch)
-      (xtdb/submit! node txs {:system-time system-time})))
-  (log/info tx-type "running query:" query)
-  (let [res (xtdb/query node query)]
-    (log/info tx-type "XTDB query response:" res)
-    res))
-
-(defn- run!-with-jdbc-conn [tx-batches query]
+                        (map #(update % :txs (partial encode-txs tx-type (:query %)))))
+        tx-results
+        (doall (mapv
+                (fn [{:keys [system-time query txs] :as batch}]
+                  (log/info tx-type "running batch: " batch)
+                  (try
+                    (if query
+                      (xtdb/query node txs)
+                      (xtdb/submit! node txs {:system-time system-time}))
+                    (catch Throwable ex
+                      (log/error "Exception while running transaction" (ex-message ex))
+                      (parse-result
+                       [{:message (ex-message ex)
+                         :exception (.getClass ex)
+                         :data (ex-data ex)}]))))
+                tx-batches))]
+    (log/warn "run!-tx-res" tx-results)
+    tx-results))
+
+
+(defn- run!-with-jdbc-conn [tx-batches]
   (xtdb/with-jdbc
     (fn [conn]
-      (doseq [txs (prepare-statements tx-batches)
-              statement txs]
-        (log/info "beta executing statement:" statement)
-        (xtdb/jdbc-execute! conn statement))
-      (log/info "beta running query:" query)
-      (let [res (xtdb/jdbc-execute! conn [query])]
-        (log/info "beta query response" res)
-        (parse-result res)))))
+      (let [tx-in-progress? (atom false)
+            res (mapv (fn [txs]
+                        (vec
+                         (mapcat
+                          (fn [statement]
+                            (log/info "beta executing statement:" statement)
+                            (when (str/includes? (str/upper-case (first statement)) "BEGIN")
+                              (reset! tx-in-progress? true))
+                            (try
+                              (let [res (parse-result (xtdb/jdbc-execute! conn statement))]
+                                (when (str/includes? (str/upper-case (first statement)) "COMMIT")
+                                  (reset! tx-in-progress? false))
+                                (if-not (vector? (ffirst res))
+                                  [res]
+                                  res))
+                              (catch Exception ex
+                                (log/error "Exception while running statement" (ex-message ex))
+                                (when @tx-in-progress?
+                                  (log/warn "Rolling back transaction")
+                                  (xtdb/jdbc-execute! conn ["ROLLBACK"]))
+                                (parse-result
+                                 [{:message (ex-message ex)
+                                   :exception (.getClass ex)
+                                   :data (ex-data ex)}]))))
+                          txs)))
+                      (prepare-statements tx-batches))]
+        (log/info "run!-with-jdbc-conn-res" res)
+        res))))
 
 (defn run!!
   "Given transaction batches, a query and the type of transaction to
   use, will run transaction batches and queries sequentially,
   returning the last query response in column format."
-  [{:keys [tx-batches query tx-type]}]
-  (let [query (if (= "xtql" tx-type) (util/read-edn query) query)]
-    (xtdb/with-xtdb
-      (fn [node]
-        (if (= "sql-v2" tx-type)
-          (run!-with-jdbc-conn tx-batches query)
-          (let [res (run!-tx node tx-type tx-batches query)]
-            (util/map-results->rows res)))))))
+  [{:keys [tx-batches tx-type]}]
+  (xtdb/with-xtdb
+    (fn [node]
+      (if (#{"sql-v2" "sql"} tx-type)
+        (run!-with-jdbc-conn tx-batches)
+        (let [res (run!-tx node tx-type tx-batches)]
+          (log/warn "run!!" res)
+          (mapv (comp vector util/map-results->rows) res))))))
 
 (defn docs-run!!
   "Given transaction batches and a query from the docs, will return the query
@@ -98,5 +179,6 @@
   (xtdb/with-xtdb
     (fn [node]
       (run!-tx node "sql"
-               (mapv #(update % :txs util/read-edn) tx-batches)
-               (util/read-edn query)))))
+               (vec
+                (conj (mapv #(update % :txs util/read-edn) tx-batches)
+                      {:txs (util/read-edn query) :query true}))))))

src/clj/xt_play/xtdb.clj

@@ -7,26 +7,24 @@
             [xtdb.node :as xtn]))
 
 (defn with-xtdb [f]
-  (try
-    (with-open [node (xtn/start-node config/node-config)]
-      (f node))
-    (catch Exception e
-      (log/warn :submit-error {:e e})
-      (throw e))))
+  (with-open [node (xtn/start-node config/node-config)]
+    (f node)))
+
+(defn query [node q]
+  (log/info :query q)
+  (xt/q node q (when (string? q) {:key-fn :snake-case-string})))
 
 (defn submit! [node txs opts]
   (log/info :submit-tx txs opts)
   (let [tx (xt/submit-tx node txs opts)
         results (xt/q node '(from :xt/txs [{:xt/id $tx-id} xt/error])
                       {:args {:tx-id (:tx-id tx)}})]
-    (log/info :submit-tx results)
-    ;; If any transaction fails, throw the error
-    (when-let [error (-> results first :xt/error)]
-      (throw error))))
-
-(defn query [node q]
-  (log/info :query q)
-  (xt/q node q (when (string? q) {:key-fn :snake-case-string})))
+    (log/info :submit-tx-result results)
+    (if-let [error (-> results first :xt/error)]
+      {:message (ex-message error)
+       :exception (.getClass error)
+       :data (ex-data error)}
+      results)))
 
 (defn with-jdbc [f]
   (with-open [conn (jdbc/get-connection config/db)]

src/cljc/xt_play/util.cljc

@@ -13,8 +13,11 @@
 
 (defn map-results->rows
   [results]
-  (let [ks (keys (apply merge results))]
-    (into [(vec ks)]
-          (mapv (fn [row]
-                  (mapv #(get row %) ks))
-                results))))
+  (if (and (seq results)
+             (every? map? results))
+    (let [ks (keys (apply merge results))]
+      (into [(vec ks)]
+            (mapv (fn [row]
+                    (mapv #(get row %) ks))
+                  results)))
+    results))

src/cljs/xt_play/app.cljs

@@ -7,7 +7,6 @@
             [reagent.core :as r]
             [goog.dom :as gdom]
             [xt-play.components.highlight :as hl]
-            [xt-play.model.query :as query]
             [xt-play.model.query-params :as query-params]
             [xt-play.model.tx-batch :as tx-batch]
             [xt-play.view :as view]))
@@ -25,29 +24,33 @@
                 js/JSON.parse
                 (js->clj :keywordize-keys true))]
     (->> txs
-         (map #(update % :system-time (fn [d] (when d (js/Date. d))))))))
+         (mapv #(update % :system-time (fn [d] (when d (js/Date. d))))))))
 
 (rf/reg-event-fx
  ::init
  [(rf/inject-cofx ::query-params/get)]
  (fn [{:keys [query-params]} [_ xt-version]]
+   ;; keep query here - this is so that any old URLs/doc links keep working - just put query w/txs (statements)
    (let [{:keys [type txs query enc]} query-params
          ;; in case of saved link with sql-beta - translate to sql-v2
          type (keyword
                (if (or (empty? type)
                        (= "sql-beta" type))
                  "sql-v2"
-                 type))]
+                 type))
+         txs (if txs
+               (param-decode txs enc)
+               [(tx-batch/default type)
+                (tx-batch/default-query type)])
+         statements (if query
+                      (conj txs {:txs (query-params/decode-from-binary query enc)
+                                 :query "true"})
+                      txs)]
      {:db {:version xt-version
            :type type
-           :enc enc
-           :query (if query
-                    (query-params/decode-from-binary query enc)
-                    (query/default type))}
+           :enc enc}
       :dispatch [::tx-batch/init
-                 (if txs
-                   (param-decode txs enc)
-                   [(tx-batch/default type)])]})))
+                 statements]})))
 
 (defonce root (createRoot (gdom/getElement "app")))
 

src/cljs/xt_play/config.cljs

@@ -3,14 +3,24 @@
 (def ^:private default-dml
   "[:put-docs :docs {:xt/id 1 :foo \"bar\"}]")
 
+(def ^:private default-xtql-query
+  "(from :docs [xt/id foo])")
+
 (def ^:private default-sql-insert
   "INSERT INTO docs (_id, col1) VALUES (1, 'foo');
 INSERT INTO docs RECORDS {_id: 2, col1: 'bar', col2:' baz'};")
 
+(def ^:private default-sql-query
+  "SELECT *, _valid_from FROM docs;")
+
 (def default-transaction
   {:sql-v2 default-sql-insert
    :xtql default-dml})
 
+(def default-query
+  {:sql-v2 default-sql-query
+   :xtql default-xtql-query})
+
 (def tx-types
   {:sql-v2 {:value :sql-v2
             :label "SQL"}