From 44411f0e944344966e2311627add605ab11ea823 Mon Sep 17 00:00:00 2001
From: Nick Alexander <nalexander@mozilla.com>
Date: Thu, 14 Jul 2016 17:42:31 -0700
Subject: [PATCH] Add hacky `<q` to DB.

---
 src/datomish/db.cljc       | 26 ++++++++++++++++++++++++++
 test/datomish/db_test.cljc | 20 ++++++++++++++++++++
 2 files changed, 46 insertions(+)

diff --git a/src/datomish/db.cljc b/src/datomish/db.cljc
index 0498a975..d7e5ede7 100644
--- a/src/datomish/db.cljc
+++ b/src/datomish/db.cljc
@@ -11,6 +11,9 @@
    [honeysql.core :as sql]
    [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
    [datomish.sqlite :as s]
+   [datomish.exec :as de]
+   [datomish.query :as dq]
+   [datomish.transforms :as dt]
    [datomish.sqlite-schema :as sqlite-schema]
    #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
              [clojure.core.async :as a :refer [go <! >!]]])
@@ -36,6 +39,29 @@
 (defn db? [x]
   (and (satisfies? IDB x)))
 
+(defn <q
+  "Execute the provided query on the provided DB.
+   Returns a transduced pair-chan of [[results] err]."
+  [db find]
+  {:pre [(db? db)]}
+  (let [attribute-transform (fn [a] (get (idents db) a a))
+        constant-transform dt/constant-transform-default
+        initial-context (dq/make-context attribute-transform constant-transform)
+        context (dq/find->into-context initial-context (dq/parse find))
+        row-pair-transducer (dq/row-pair-transducer context (dq/sql-projection context))
+        chan (a/chan 50 row-pair-transducer)]
+
+    (s/<?all-rows (:sqlite-connection db) (dq/context->sql-string context) chan)
+    ;; TODO: extract this reducing function lifted to the Maybe monad.
+    (let [g (fn [f [rv re] [v e]]
+              (if re
+                [nil re]
+                (if e
+                  [nil e]
+                  [(f rv v) nil])))]
+      (go-pair
+        (<? (a/reduce (partial g conj) [[] nil] chan))))))
+
 ;; TODO: implement support for DB parts?
 (def tx0 0x2000000)
 
diff --git a/test/datomish/db_test.cljc b/test/datomish/db_test.cljc
index d3dc29b6..a4d23b8d 100644
--- a/test/datomish/db_test.cljc
+++ b/test/datomish/db_test.cljc
@@ -101,3 +101,23 @@
                   [txb txInstant -1 txb 1]])))
         (finally
           (<? (db/close db)))))))
+
+(deftest-async test-q
+  (with-tempfile [t (tempfile)]
+    (let [c  (<? (s/<sqlite-connection t))
+          db (<? (db/<with-sqlite-connection c))]
+      (try
+        (let [now        -1
+              txInstant  (<? (db/<entid db :db/txInstant)) ;; TODO: convert entids to idents on egress.
+              x          (<? (db/<entid db :x))            ;; TODO: convert entids to idents on egress.
+              report     (<? (db/<transact! db [[:db/add 0 :x "valuex"]] nil now))
+              current-tx (:current-tx report)]
+          (is (= current-tx db/tx0))
+          (is (= (<? (<datoms db))
+                 [[0 x "valuex" db/tx0 true]
+                  [db/tx0 txInstant now db/tx0 true]]))
+          (is (= (<? (db/<q db '[:find ?e ?a ?v ?tx :in $ :where [?e ?a ?v ?tx]]))
+                 [[1 x "valuex" db/tx0] ;; TODO: include added.
+                  [db/tx0 txInstant now db/tx0]])))
+        (finally
+          (<? (db/close db)))))))