datomic-cloud-core-logic.clj

(require 
  '[datomic.client.api :as d]
  '[clojure.core.logic :refer :all]
  '[clojure.core.logic.datomic :as ld])

(defn entid [db k] 
  (-> db
      (d/pull [:db/id] [:db/ident k])
      :db/id))

(defmacro ^:private compile-if
  "Evaluate `exp` and if it returns logical true and doesn't error, expand to
  `then`.  Else expand to `else`.
  (compile-if (Class/forName \"java.util.concurrent.ForkJoinTask\")
    (do-cool-stuff-with-fork-join)
    (fall-back-to-executor-services))"
  [exp then else]
  (if (try (eval exp)
           (catch Throwable _ false))
    `(do ~then)
    `(do ~else)))

(compile-if
  (Class/forName "datomic.client.impl.shared.datom.Datom")

  (do
    (require
      '[clojure.core.logic.protocols :refer :all]
      '[clojure.core.logic :refer :all]
      '[datomic.client.api :only [db q] :as d])

    (defn datom? [x]
      (instance? datomic.client.impl.shared.datom.Datom x))

    (defn unify-with-datom* [u v s]
      (when (and (instance? clojure.lang.PersistentVector v) (> (count v) 1))
        (loop [i 0 v v s s]
          (if (empty? v)
            s
            (when-let [s (unify s (first v) (nth u i))]
              (recur (inc i) (next v) s))))))
    
    (extend-type datomic.client.impl.shared.datom.Datom
      IUnifyTerms
      (unify-terms [u v s]
        (unify-with-datom* u v s)))

    (extend-type clojure.lang.PersistentVector
      IUnifyTerms
      (unify-terms [u v s]
        (if (datom? v)
          (unify-with-datom* v u s)
          (when (sequential? v)
            (unify-with-sequential* u v s)))))

    (defn fillq [q]
      (reduce conj q (repeatedly (- 4 (count q)) lvar)))

    (defmulti index-and-components-for
              (fn [a q]
                (->> (fillq q)
                     (map (fn [x] (if (lvar? (walk a x)) ::fresh ::ground)))
                     (into []))))

    (derive ::fresh ::any)
    (derive ::ground ::any)

    (defmethod index-and-components-for [::ground ::any ::any ::any]
      [a q]
      [:eavt (fillq q)])

    (defmethod index-and-components-for [::fresh ::ground ::fresh ::any]
      [a q]
      (let [[e a v t] (fillq q)]
        [:aevt [a e v t]]))

    (defmethod index-and-components-for [::fresh ::ground ::ground ::any]
      [a q]
      (let [[e a v t] (fillq q)]
        [:avet [a v e t]]))

    (defmethod index-and-components-for [::fresh ::fresh ::ground ::any]
      [a q]
      (let [[e a v t] (fillq q)]
        [:vaet [v a e t]]))

    (defn query [db q]
      (fn [a]
        (let [->id (fn [x]
                     (if (keyword? x)
                       (or (entid db x) x)
                       x))
              q (walk a q)
              [index components] (index-and-components-for a q)
              ground-components (->> components
                                     (take-while #(not (lvar? (walk a %))))
                                     (walk* a)
                                     (map ->id))]
          (to-stream
            (map (fn [datom]
                   (unify a (into [] (map ->id q)) datom))
                 (d/datoms db {:index index :components ground-components})))))))
  (comment
    
    ))

(let [db (get-the-db)]
   (run 5 [q]
     (fresh [e name phone]
            (query db [e :member/label name])
            (query db [e :member/phone phone])
            (== q name))))
;; => ("Aunt Sherae" "Ralph and Ramona" "Richard&Marlene" "Love you Bex and Joe! Brittney" "Olivia")