Skip to content

Instantly share code, notes, and snippets.

@comnik comnik/deps.edn
Created Jun 26, 2018

Embed
What would you like to do?
A GraphQL-like Query Language for Datomic (https://nikolasgoebel.com/2018/06/26/a-query-language.html)
{:deps
{org.clojure/clojure {:mvn/version "1.9.0"}
com.datomic/datomic-free {:mvn/version "0.9.5697"}}}
(require '[clojure.set :as set])
(require '[datomic.api :as d])
(load "parser")
(defmulti impl (fn [ctx node] (first node)))
(defn pull [db pattern eids]
(let [ctx {:db db
:datoms #{}
:eids eids}]
(impl ctx [:pattern pattern])))
(defmethod impl :pattern [ctx [_ specs]]
(reduce impl ctx specs))
(defmethod impl :attribute [{:keys [db eids] :as ctx} [_ attr]]
(let [datoms (into #{}
(filter (fn [datom] (contains? eids (.-e datom))))
(d/datoms db :aevt attr))]
(update ctx :datoms set/union datoms)))
(defmethod impl :expand [{:keys [db eids] :as ctx} [_ map-spec]]
(let [[attr pattern] (first map-spec)
children (into #{}
(filter (fn [datom] (contains? eids (.-e datom))))
(d/datoms db :aevt attr))
children-eids (into #{} (map :v) children)
children-ctx (pull db pattern children-eids)]
(-> ctx
(update :eids set/union (:eids children-ctx))
(update :datoms set/union (into #{} (filter (fn [datom]
(contains? (:eids children-ctx) (.-v datom))) children)))
(update :datoms set/union (:datoms children-ctx)))))
(defmethod impl :clause [{:keys [db eids] :as ctx} [_ clause]]
(let [[_ data-pattern] clause
[attr v] data-pattern
indexed? (:indexed (d/attribute db attr))
matching-datoms (if indexed?
(into #{} (d/datoms db :avet attr v))
(into #{}
(filter (fn [datom] (= (.-v datom) v)))
(d/datoms db :aevt attr)))]
(-> ctx
(update :datoms set/union matching-datoms)
(update :eids set/intersection (into #{} (map :e) matching-datoms)))))
(defn resolve-root [db root]
(case root
:human (set (d/q '[:find [?e ...] :where [?e :human/name _]] db))))
(defn resolve-query [db query]
(->> query
(parse)
(reduce-kv
(fn [result root pattern]
(let [root-eids (resolve-root db root)
ctx (pull db pattern root-eids)
eids (:eids ctx)
entities (->> (:datoms ctx)
(reduce
(fn [tree datom]
(if-not (contains? eids (.-e datom))
tree
(let [attr (d/attribute db (.-a datom))
ref? (= (:value-type attr) :db.type/ref)]
(if ref?
(update-in tree [(.-e datom) (:ident attr)] conj (.-v datom))
(assoc-in tree [(.-e datom) (:ident attr)] (.-v datom)))))) {}))
hydrate (fn [eid]
(->> (get entities eid)
(reduce-kv
(fn [entity a v]
(let [attr (d/attribute db a)
ref? (= (:value-type attr) :db.type/ref)]
(if-not ref?
(assoc entity a v)
(if (coll? v)
(assoc entity a (mapv entities v))
(assoc entity a (get entities v)))))) {})))
;; hydrate
tree (->> root-eids
(into [] (comp (map hydrate) (remove empty?))))]
(assoc result root tree))) {})))
;; TRY IT OUT
(comment
(def uri "datomic:mem://language")
(d/create-database uri)
(def conn (d/connect uri))
(def schema
[{:db/ident :human/name
:db/valueType :db.type/string
:db/unique :db.unique/identity
:db/cardinality :db.cardinality/one}
{:db/ident :human/starships
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many}
{:db/ident :ship/name
:db/valueType :db.type/string
:db/unique :db.unique/identity
:db/cardinality :db.cardinality/one}
{:db/ident :ship/class
:db/valueType :db.type/keyword
:db/cardinality :db.cardinality/one}])
(d/transact conn schema)
(d/transact conn
[{:human/name "Naomi Nagata"
:human/starships [{:db/id "roci" :ship/name "Roci" :ship/class :ship.class/fighter}
{:ship/name "Anubis" :ship/class :ship.class/science-vessel}]}
{:human/name "Amos Burton"
:human/starships ["roci"]}])
;; verify
(d/q '[:find ?e ?name :where [?e :human/name ?name]] (d/db conn))
(d/q '[:find [?name ...] :where [_ :ship/name ?name]] (d/db conn))
(d/pull (d/db conn) '[:human/name {:human/starships [*]}] [:human/name "Naomi Nagata"])
(resolve-query (d/db conn) '{:human [:human/name]})
(resolve-query (d/db conn) '{:human [:human/name
{:human/starships [:ship/name
:ship/class]}]})
(resolve-query (d/db conn) '{:human [[:human/name "Naomi Nagata"]
{:human/starships [:ship/name :ship/class]}]})
(resolve-query (d/db conn)
'{:human [:human/name
{:human/starships [:ship/name
[:ship/class :ship.class/fighter]]}]}))
(require '[clojure.string :as str])
(require '[clojure.spec.alpha :as s])
;; A simple GraphQL expression:
;;
;; {
;; human(id: 1002) {
;; name
;; starships {
;; name
;; class
;; }
;; }
;; }
;;
;; Translated into Datalog, this could look a bit like this:
'{:human [:human/name
{:human/starships [:ship/name
:ship/class]}]}
;; As we can see, GraphQL also allows to specify arguments on the
;; root, allowing clients to filter out the entities that they're
;; interested in. We could translate this as such:
'{(human {:db/id 1002}) [:human/name
{:human/starships [:ship/name
:ship/class]}]}
;; But just to keep things fresh and interesting, let's do it in a bit
;; more general, clause-oriented way.
'{:human [[:db/id 1002]
:human/name
{:human/starships [:ship/name
:ship/class]}]}
;; Note that this would allows us to do something that GraphQL can't,
;; which is to filter nested relations as well.
'{:human [[:db/id 1002]
:human/name
{:human/starships [[:ship/name "Anubis"]
:ship/class]}]}
;; Let's formalize this into a grammar.
(s/def ::query (s/map-of keyword? ::pattern))
(s/def ::pattern (s/coll-of ::attr-spec))
(s/def ::attr-spec (s/or :attribute ::attr-name
:clause ::clause
:expand ::map-spec))
(s/def ::attr-name keyword?)
(s/def ::clause (s/or :data-pattern ::data-pattern))
(s/def ::data-pattern (s/tuple ::attr-name ::constant))
(s/def ::constant (constantly true)) ;; @TODO
(s/def ::map-spec (s/and (s/map-of ::attr-name ::pattern)
#(= (count %) 1)))
;; core.spec then gives us a parser for free
(defn parse [query]
(let [conformed (s/conform ::query query)]
(if (s/invalid? conformed)
(throw (ex-info "Couldn't parse query" (s/explain-data ::query query)))
conformed)))
(comment
;; Try it out
(parse '{:human [:human/name
{:human/starships [:ship/name :ship/class]}]})
(parse '{:human [[:db/id 1002]
:human/name
{:human/starships [[:ship/name "Anubis"]
:ship/class]}]})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.