├── bin └── kaocha ├── .gitignore ├── Makefile ├── tests.edn ├── resources └── clj-kondo.exports │ └── magnars.com │ └── datomic-type-extensions │ ├── config.edn │ └── hooks │ └── datomic_type_extensions.clj ├── src └── datomic_type_extensions │ ├── types.clj │ ├── core.clj │ ├── entity.clj │ ├── query.clj │ └── api.clj ├── project.clj ├── doc └── query-return-maps.md ├── test └── datomic_type_extensions │ ├── query_test.clj │ └── api_test.clj └── README.md /bin/kaocha: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | lein kaocha "$@" 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.nrepl-port 2 | /target 3 | /pom.xml 4 | /.lein-failures 5 | /pom.xml.asc 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | test: 2 | ./bin/kaocha 3 | 4 | deploy: 5 | lein deploy clojars 6 | 7 | .PHONY: test 8 | -------------------------------------------------------------------------------- /tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | {:plugins [:noyoda.plugin/swap-actual-and-expected] 3 | :tests [{:id :unit 4 | :source-paths ["src"] 5 | :focus-meta [:focus]}]} 6 | -------------------------------------------------------------------------------- /resources/clj-kondo.exports/magnars.com/datomic-type-extensions/config.edn: -------------------------------------------------------------------------------- 1 | {:hooks 2 | {:analyze-call 3 | {datomic-type-extensions.types/define-dte hooks.datomic-type-extensions/define-dte}}} 4 | -------------------------------------------------------------------------------- /src/datomic_type_extensions/types.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-type-extensions.types) 2 | 3 | (defmulti get-backing-datomic-type identity) 4 | 5 | (defmulti serialize (fn [type _] type)) 6 | (defmulti deserialize (fn [type _] type)) 7 | 8 | (defmacro define-dte [id backing-type serialize-sig serialize-body deserialize-sig deserialize-body] 9 | `(do 10 | (defmethod get-backing-datomic-type ~id [_#] ~backing-type) 11 | (defmethod serialize ~id [_# ~@serialize-sig] ~serialize-body) 12 | (defmethod deserialize ~id [_# ~@deserialize-sig] ~deserialize-body))) 13 | -------------------------------------------------------------------------------- /resources/clj-kondo.exports/magnars.com/datomic-type-extensions/hooks/datomic_type_extensions.clj: -------------------------------------------------------------------------------- 1 | (ns hooks.datomic-type-extensions 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn define-dte [{:keys [node]}] 5 | (let [[_ _ binding1 body1 binding2 body2] (rest (:children node))] 6 | {:node 7 | (api/vector-node 8 | [(api/list-node 9 | (list 10 | (api/token-node 'fn) 11 | binding1 12 | body1)) 13 | (api/list-node 14 | (list 15 | (api/token-node 'fn) 16 | binding2 17 | body2))])})) 18 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject datomic-type-extensions "2025.01.24" 2 | :description "A Clojure library that wraps Datomic API functions to add type extensions." 3 | :url "https://github.com/magnars/datomic-type-extensions" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[potemkin "0.4.5"]] 7 | :resource-paths ["resources"] 8 | :profiles {:dev {:dependencies [[org.clojure/clojure "1.10.0"] 9 | [com.datomic/peer "1.0.6726"] 10 | [java-time-literals "2018-04-06"] 11 | [org.clojure/tools.cli "0.4.1"] ;; for kaocha to recognize command line options 12 | [lambdaisland/kaocha "0.0-389"] 13 | [kaocha-noyoda "2019-01-29"]] 14 | :injections [(require 'java-time-literals.core)] 15 | :plugins [] 16 | :source-paths ["dev"]}} 17 | :aliases {"kaocha" ["run" "-m" "kaocha.runner"]}) 18 | -------------------------------------------------------------------------------- /doc/query-return-maps.md: -------------------------------------------------------------------------------- 1 | Design notes for implementation of datomic query return maps 2 | ============================================================ 3 | 4 | Terminology 5 | ----------- 6 | 7 | | term | example | definition | 8 | |-----------------|-------------------------------------|-----------------------------------------| 9 | | query | `[:find ?e :where ?e :person/name]` | a map-form or vector-form Datomic query | 10 | | query-map | `{:query query :args args}` | query with args, including db | 11 | | return-map-keys | `[:name :age]` | keys present in returned maps | 12 | 13 | Error messages in Datomic and datomic-type-extensions 14 | ----------------------------------------------------- 15 | 16 | - A datomic-type-extensions user that has written an illegal query combining 17 | return maps with a :find clause that does not return a set of tuples will 18 | get worse error messages than Datomic can provide. 19 | 20 | Examples: 21 | 22 | [:find [?name ...] :keys name :where [_ :person/name ?name]] 23 | [:find ?name . :keys name :where [_ :person/name ?name]] 24 | 25 | In these cases, Datomic will return something that doesn't make sense to 26 | use with query return maps - as the user already has requested a different 27 | type of output than sequence of maps. 28 | 29 | - Worse error messages than datomic if the user requests return maps that 30 | contain an illegal number of keys. 31 | 32 | Example: 33 | 34 | [:find ?name ?age :keys name :where [_ :person/name ?name]] 35 | 36 | Datomic catches this error by analyzing the query, datomic-type-extensions 37 | catches this error when the return value from the query isn't a set of tuples. 38 | 39 | In other words, the implementation of datomic query return maps in 40 | datomic-type-extensions is, unfortunately, leaky! 41 | -------------------------------------------------------------------------------- /src/datomic_type_extensions/core.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-type-extensions.core 2 | (:require [clojure.walk :refer [postwalk prewalk]] 3 | [datomic.api :as d] 4 | [datomic-type-extensions.types :as types])) 5 | 6 | (defn apply-to-value [f attr-info val] 7 | (case (:db/cardinality attr-info) 8 | :db.cardinality/one (f val) 9 | :db.cardinality/many (cond 10 | (set? val) (set (map f val)) 11 | (list? val) (map f val) 12 | (vector? val) (mapv f val) 13 | :else (throw (ex-info "Value must be either set, list or vector" 14 | {:attr-info attr-info :val val}))))) 15 | 16 | (defn serialize-assertion-tx [form attr->attr-info] 17 | (if-let [[op e a v] (and (vector? form) form)] 18 | (let [attr-info (get attr->attr-info a)] 19 | (if (and (#{:db/add :db/retract} op) 20 | (:dte/valueType attr-info) 21 | (some? v)) 22 | (update form 3 #(apply-to-value (partial types/serialize (:dte/valueType attr-info)) attr-info %)) 23 | form)) 24 | form)) 25 | 26 | (defn- update-attr [f form [k attr-info]] 27 | (if (get form k) 28 | (update form k #(apply-to-value (partial f (:dte/valueType attr-info)) attr-info %)) 29 | form)) 30 | 31 | (defn serialize-tx-data [attr->attr-info tx-data] 32 | (prewalk 33 | (fn [form] 34 | (cond 35 | (map? form) (reduce #(update-attr types/serialize %1 %2) form attr->attr-info) 36 | (vector? form) (serialize-assertion-tx form attr->attr-info) 37 | :else form)) 38 | tx-data)) 39 | 40 | (defn deserialize [attr->attr-info form] 41 | (postwalk 42 | (fn [form] 43 | (if (map? form) 44 | (reduce #(update-attr types/deserialize %1 %2) form attr->attr-info) 45 | form)) 46 | form)) 47 | 48 | (defn serialize-lookup-ref [attr->attr-info eid] 49 | (if-let [attr-info (and (vector? eid) 50 | (attr->attr-info (first eid)))] 51 | (update eid 1 #(types/serialize (:dte/valueType attr-info) %)) 52 | eid)) 53 | -------------------------------------------------------------------------------- /src/datomic_type_extensions/entity.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-type-extensions.entity 2 | (:require [datomic-type-extensions.core :as core] 3 | [datomic-type-extensions.types :as types]) 4 | (:import datomic.query.EntityMap)) 5 | 6 | (defmacro either 7 | "Like clojure.core/or, but treats false as a truthy value" 8 | ([] nil) 9 | ([x] x) 10 | ([x & next] 11 | `(if-some [false-or-truthy# ~x] 12 | false-or-truthy# 13 | (either ~@next)))) 14 | 15 | (declare wrap equiv-entity) 16 | 17 | (defn deserialize-attr [entity attr->attr-info attr] 18 | (when-let [val (attr entity)] 19 | (when-let [attr-info (get attr->attr-info attr)] 20 | (core/apply-to-value (partial types/deserialize (:dte/valueType attr-info)) 21 | attr-info 22 | val)))) 23 | 24 | (deftype TypeExtendedEntityMap [^EntityMap entity attr->attr-info touched?] 25 | Object 26 | (hashCode [_] (hash [(.hashCode entity) attr->attr-info])) 27 | (equals [this o] (and (instance? TypeExtendedEntityMap o) 28 | (equiv-entity this o))) 29 | 30 | clojure.lang.Seqable 31 | (seq [_] (map (fn [[k v]] 32 | (clojure.lang.MapEntry. 33 | k 34 | (either (deserialize-attr entity attr->attr-info k) 35 | (wrap (.valAt entity k) attr->attr-info)))) 36 | (.seq entity))) 37 | 38 | clojure.lang.Associative 39 | (equiv [this o] (and (instance? TypeExtendedEntityMap o) 40 | (equiv-entity this o))) 41 | (containsKey [_ k] (.containsKey entity k)) 42 | (entryAt [_ k] (let [v (either (deserialize-attr entity attr->attr-info k) 43 | (some-> entity (.entryAt k) .val (wrap attr->attr-info)))] 44 | (when (some? v) (first {k v})))) 45 | (empty [_] (wrap (.empty entity) attr->attr-info)) 46 | (count [_] (.count entity)) 47 | 48 | clojure.lang.ILookup 49 | (valAt [_ k] (either (deserialize-attr entity attr->attr-info k) 50 | (wrap (.valAt entity k) attr->attr-info))) 51 | (valAt [_ k not-found] (either (deserialize-attr entity attr->attr-info k) 52 | (wrap (.valAt entity k not-found) attr->attr-info))) 53 | 54 | datomic.Entity 55 | (db [_] (assoc (.db entity) :datomic-type-extensions.api/attr->attr-info attr->attr-info)) 56 | (get [_ k] (wrap (.get entity k) attr->attr-info)) 57 | (keySet [_] (.keySet entity)) 58 | (touch [this] (do (.touch entity) 59 | (reset! touched? true) 60 | this))) 61 | 62 | (defn- equiv-entity [^TypeExtendedEntityMap e1 ^TypeExtendedEntityMap e2] 63 | (.equiv (let [^EntityMap em (.entity e1)] em) 64 | (let [^EntityMap em (.entity e2)] em))) 65 | 66 | (defmethod print-method TypeExtendedEntityMap [entity writer] 67 | (print-method (merge {:db/id (:db/id entity)} 68 | (when @(.-touched? entity) 69 | (into {} entity))) 70 | writer)) 71 | 72 | (defn wrap 73 | [x attr->attr-info] 74 | (cond 75 | (instance? datomic.Entity x) 76 | (TypeExtendedEntityMap. x attr->attr-info (atom false)) 77 | 78 | (coll? x) 79 | (set (map #(wrap % attr->attr-info) x)) 80 | 81 | :else x)) 82 | -------------------------------------------------------------------------------- /src/datomic_type_extensions/query.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-type-extensions.query 2 | (:require [datomic-type-extensions.core :as core] 3 | [datomic-type-extensions.types :as types])) 4 | 5 | (defn find-binding [[e a v]] 6 | (cond 7 | (keyword? a) [v a] 8 | 9 | (and (seq? e) (= 'get-else (first e))) 10 | [a (nth e 3)])) 11 | 12 | (defn find-var->type-mapping [query attr->attr-info] 13 | (let [where-clauses (:where query)] 14 | (->> (keep find-binding where-clauses) 15 | (keep (fn [[v a]] (when-let [attr-info (attr->attr-info a)] 16 | [v (:dte/valueType attr-info)]))) 17 | (into {})))) 18 | 19 | (defn deserialization-pattern [query attr->attr-info] 20 | (let [find-clauses (:find query) 21 | var->type (find-var->type-mapping query attr->attr-info) 22 | find-pattern #(if (and (seq? %) (= 'pull (first %))) 23 | {:type :deserializable-form} 24 | (var->type %))] 25 | (cond 26 | (= '. (fnext find-clauses)) 27 | (find-pattern (first find-clauses)) 28 | 29 | (vector? (first find-clauses)) 30 | {:type :vector 31 | :pattern (find-pattern (ffirst find-clauses))} 32 | 33 | :else 34 | {:type :set 35 | :pattern {:type :tuple 36 | :entries (mapv find-pattern find-clauses)}}))) 37 | 38 | (defn deserialize-by-pattern [form pattern attr->attr-info] 39 | (cond 40 | (keyword? pattern) 41 | (types/deserialize pattern form) 42 | 43 | (= (:type pattern) :vector) 44 | (mapv #(deserialize-by-pattern % (:pattern pattern) attr->attr-info) form) 45 | 46 | (= (:type pattern) :tuple) 47 | (mapv #(deserialize-by-pattern %1 %2 attr->attr-info) form (:entries pattern)) 48 | 49 | (= (:type pattern) :set) 50 | (set (map #(deserialize-by-pattern % (:pattern pattern) attr->attr-info) form)) 51 | 52 | (= (:type pattern) :deserializable-form) 53 | (core/deserialize attr->attr-info form) 54 | 55 | :else form)) 56 | 57 | (def ^{:doc "Keywords that signify that a new query clause is starting. 58 | 59 | Source: https://docs.datomic.com/query/query-data-reference.html"} 60 | datomic-query-clause-keywords 61 | #{:find 62 | :keys :syms :strs 63 | :with 64 | :in 65 | :where}) 66 | 67 | (defn list-form->map-form [list-form-query] 68 | (->> list-form-query 69 | (partition-by datomic-query-clause-keywords) 70 | (partition 2) 71 | (map (fn [[[k] clauses]] 72 | [k (vec clauses)])) 73 | (into {}))) 74 | 75 | (defn ->map-form 76 | [query] 77 | (cond 78 | (map? query) query 79 | (string? query) (throw (ex-info "String-form Datomic queries are not supported by datomic-type-extensions" {})) 80 | (vector? query) (list-form->map-form query))) 81 | 82 | (defn return-map-keys [query] 83 | (let [return-map-part (select-keys query [:strs :keys :syms])] 84 | (when (seq return-map-part) 85 | (when-not (= 1 (count return-map-part)) 86 | (throw (ex-info "Invalid return map request" 87 | {:map-form-query query 88 | :error ::more-than-one-return-map-clause}))) 89 | (when-not (seq (val (first return-map-part))) 90 | (throw (ex-info "Invalid return map request" 91 | {:map-form-query query 92 | :error ::return-map-keys-not-seqence}))) 93 | (let [[key-type the-keys] (first return-map-part) 94 | coerce-key (get {:strs str :keys keyword :syms symbol} key-type)] 95 | (mapv coerce-key the-keys))))) 96 | 97 | (defn strip-return-maps [query] 98 | (dissoc query :strs :keys :syms)) 99 | 100 | (defn return-maps [raw-query-results return-map-keys] 101 | (if (seq return-map-keys) 102 | (do 103 | (when (not (and (seq raw-query-results) 104 | (seq (first raw-query-results)))) 105 | (throw (ex-info "Return map keys are provided, and query results have illegal data format" 106 | {:raw-query-results raw-query-results :return-map-keys return-map-keys}))) 107 | (when (not (= (count return-map-keys) 108 | (count (first raw-query-results)))) 109 | (throw (ex-info "Return map key count does not match row size" 110 | {:raw-query-results raw-query-results :return-map-keys return-map-keys}))) 111 | (mapv (partial zipmap return-map-keys) raw-query-results)) 112 | raw-query-results)) 113 | 114 | (comment 115 | 116 | (def query '{:find [?name] 117 | :where [[_ :person/name ?name]]}) 118 | (= query (->map-form query)) 119 | 120 | ) 121 | -------------------------------------------------------------------------------- /test/datomic_type_extensions/query_test.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-type-extensions.query-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [datomic-type-extensions.query :as sut])) 4 | 5 | (defn attr-info [value-type] 6 | {:dte/valueType value-type 7 | :db/cardinality :db.cardinality/one}) 8 | 9 | (def attr->attr-info 10 | {:user/created-at (attr-info :java.time/instant) 11 | :user/updated-at (attr-info :java.time/instant) 12 | :client/id (attr-info :keyword-backed-by-string)}) 13 | 14 | (deftest deserialization-pattern 15 | (testing "a single value" 16 | (testing "- serialized" 17 | (is (= :java.time/instant 18 | (sut/deserialization-pattern 19 | '{:find [?v .] :where [[?e :user/created-at ?v]]} 20 | attr->attr-info)))) 21 | 22 | (testing "- not serialized" 23 | (is (nil? (sut/deserialization-pattern 24 | '{:find [?v .] :where [[?e :user/name ?v]]} 25 | attr->attr-info)))) 26 | 27 | (testing "- entity id" 28 | (is (nil? (sut/deserialization-pattern 29 | '{:find [?e .] :where [[?e :user/created-at ?v]]} 30 | attr->attr-info))))) 31 | 32 | (testing "vector" 33 | (is (= {:type :vector 34 | :pattern :java.time/instant} 35 | (sut/deserialization-pattern 36 | '{:find [[?v ...]] :where [[?e :user/created-at ?v]]} 37 | attr->attr-info)))) 38 | 39 | (testing "sets of tuples" 40 | (is (= {:type :set 41 | :pattern {:type :tuple 42 | :entries [nil :java.time/instant]}} 43 | (sut/deserialization-pattern 44 | '{:find [?e ?v] :where [[?e :user/created-at ?v]]} 45 | attr->attr-info)))) 46 | 47 | (testing "pull syntax" 48 | (is (= {:type :vector 49 | :pattern {:type :deserializable-form}} 50 | (sut/deserialization-pattern 51 | '{:find [[(pull ?e [:user/email :user/created-at]) ...]] 52 | :where [[?e :user/created-at ?v]]} 53 | attr->attr-info))) 54 | 55 | (is (= {:type :deserializable-form} 56 | (sut/deserialization-pattern 57 | '{:find [(pull ?e [:user/email :user/created-at]) .] 58 | :where [[?e :user/created-at ?v]]} 59 | attr->attr-info))) 60 | 61 | (is (= {:type :set 62 | :pattern {:type :tuple 63 | :entries [nil {:type :deserializable-form}]}} 64 | (sut/deserialization-pattern 65 | '{:find [?e (pull ?e [:user/email])] 66 | :where [[?e :user/created-at ?v]]} 67 | attr->attr-info))))) 68 | 69 | (deftest deserialize-by-pattern 70 | (is (= :client-id 71 | (sut/deserialize-by-pattern "client-id" :keyword-backed-by-string {}))) 72 | 73 | (is (= [:client-id-1 :client-id-2] 74 | (sut/deserialize-by-pattern ["client-id-1" "client-id-2"] 75 | {:type :vector 76 | :pattern :keyword-backed-by-string} 77 | {}))) 78 | 79 | (is (= ["not-a-client-id" :client-id "nope"] 80 | (sut/deserialize-by-pattern ["not-a-client-id" "client-id" "nope"] 81 | {:type :tuple 82 | :entries [nil :keyword-backed-by-string nil]} 83 | {}))) 84 | 85 | (is (= #{["not-a-client-id" :client-id]} 86 | (sut/deserialize-by-pattern #{["not-a-client-id" "client-id"]} 87 | {:type :set 88 | :pattern {:type :tuple 89 | :entries [nil :keyword-backed-by-string]}} 90 | {})))) 91 | 92 | (deftest find-var->type-mapping 93 | (is (= {'?v :java.time/instant} 94 | (sut/find-var->type-mapping '{:find [?v] :where [[_ :user/created-at ?v]]} 95 | attr->attr-info))) 96 | 97 | (is (= {'?updated :java.time/instant} 98 | (sut/find-var->type-mapping '{:find [?email ?updated] 99 | :in [$] 100 | :where [[?e :user/email ?email] 101 | [(get-else $ ?e :user/updated-at nil) ?updated]]} 102 | attr->attr-info)))) 103 | 104 | (deftest list-form-query->map-form-query 105 | (is 106 | (= '{:find [?name] 107 | :where [[_ :person/name ?name]]} 108 | (sut/list-form->map-form 109 | '[:find ?name 110 | :where [_ :person/name ?name]])))) 111 | 112 | (deftest return-map-keys 113 | (is (= [:name :age] 114 | (sut/return-map-keys 115 | '{:find [?e] 116 | :keys [name age] 117 | :where [[?e :person/name]]}))) 118 | (is (= [:person/name :person/age] 119 | (sut/return-map-keys 120 | '{:find [?e] 121 | :keys [person/name person/age] 122 | :where [[?e :person/name]]}))) 123 | (is (= '[name age] 124 | (sut/return-map-keys 125 | '{:find [?e] 126 | :syms [name age] 127 | :where [[?e :person/name]]}))) 128 | (is (= ["name" "age"] 129 | (sut/return-map-keys 130 | '{:find [?e] 131 | :strs [name age] 132 | :where [[?e :person/name]]}))) 133 | (testing "throws when two key types are supplied" 134 | (is 135 | (thrown? clojure.lang.ExceptionInfo 136 | (sut/return-map-keys 137 | '{:find [?e] 138 | :keys [name] 139 | :syms [age] 140 | :where [[?e :person/name]]}))))) 141 | 142 | (deftest return-maps-request 143 | (is (= #{{:name "Teodor"} {:name "Magnar"}} 144 | (set 145 | (sut/return-maps #{["Teodor"] 146 | ["Magnar"]} 147 | '[:name]))))) 148 | 149 | (comment 150 | (remove-ns (symbol (str *ns*))) 151 | (set! *print-namespace-maps* false) 152 | ) 153 | -------------------------------------------------------------------------------- /src/datomic_type_extensions/api.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-type-extensions.api 2 | (:refer-clojure :exclude [filter sync]) 3 | (:require [clojure.walk :refer [postwalk]] 4 | [datomic-type-extensions.core :as core] 5 | [datomic-type-extensions.entity :as entity] 6 | [datomic-type-extensions.query :as query] 7 | [datomic-type-extensions.types :as types] 8 | [datomic.api :as d] 9 | [potemkin :refer [import-vars]])) 10 | 11 | ;; store attr->attr-info in db 12 | 13 | (defn add-backing-types [tx] 14 | (postwalk 15 | (fn [form] 16 | (if-let [type (and (map? form) (:dte/valueType form))] 17 | (assoc form :db/valueType (types/get-backing-datomic-type type)) 18 | form)) 19 | tx)) 20 | 21 | (defn query-attr->attr-info [db] 22 | (->> (for [attr (->> (d/q '[:find [?e ...] :where [?e :dte/valueType]] db) 23 | (map #(d/entity db %)))] 24 | [(:db/ident attr) (select-keys attr #{:db/cardinality :dte/valueType})]) 25 | (into {}))) 26 | 27 | (defn find-attr->attr-info [db] 28 | (or (::attr->attr-info db) 29 | (query-attr->attr-info db))) 30 | 31 | (def init-txs 32 | [{:db/ident :dte/valueType 33 | :db/valueType :db.type/keyword 34 | :db/cardinality :db.cardinality/one}]) 35 | 36 | (defn init! [conn] 37 | (when-not (d/entity (d/db conn) :dte/valueType) 38 | @(d/transact conn init-txs))) 39 | 40 | (defn prepare-tx-data [db tx-data] 41 | (->> tx-data 42 | (core/serialize-tx-data (find-attr->attr-info db)) 43 | (add-backing-types))) 44 | 45 | ;; datomic.api 46 | 47 | (defn transact [connection tx-data] 48 | (d/transact connection (prepare-tx-data (d/db connection) tx-data))) 49 | 50 | (defn transact-async [connection tx-data] 51 | (d/transact-async connection (prepare-tx-data (d/db connection) tx-data))) 52 | 53 | (defn with [db tx-data] 54 | (d/with db (prepare-tx-data db tx-data))) 55 | 56 | (defn entity [db eid] 57 | (let [attr->attr-info (find-attr->attr-info db)] 58 | (entity/wrap (d/entity db (core/serialize-lookup-ref attr->attr-info eid)) 59 | attr->attr-info))) 60 | 61 | (defn pull [db pattern eid] 62 | (let [attr->attr-info (find-attr->attr-info db)] 63 | (->> (d/pull db pattern (core/serialize-lookup-ref attr->attr-info eid)) 64 | (core/deserialize attr->attr-info)))) 65 | 66 | (defn pull-many [db pattern eids] 67 | (let [attr->attr-info (find-attr->attr-info db)] 68 | (->> (d/pull-many db pattern (map #(core/serialize-lookup-ref attr->attr-info %) eids)) 69 | (core/deserialize attr->attr-info)))) 70 | 71 | (defn since [db t] 72 | (assoc (d/since db t) ::attr->attr-info (find-attr->attr-info db))) 73 | 74 | (defn filter [db pred] 75 | (assoc (d/filter db pred) ::attr->attr-info (find-attr->attr-info db))) 76 | 77 | (defn history [db] 78 | (assoc (d/history db) ::attr->attr-info (find-attr->attr-info db))) 79 | 80 | (defn db [connection] 81 | (let [db (d/db connection)] 82 | (assoc db ::attr->attr-info (find-attr->attr-info db)))) 83 | 84 | (defn connect [uri] 85 | (let [conn (d/connect uri)] 86 | (init! conn) 87 | conn)) 88 | 89 | (defn query [query-map] 90 | (let [args (:args query-map) 91 | query (query/->map-form (:query query-map)) 92 | db (first args) 93 | _ (when-not (instance? datomic.db.Db db) 94 | (throw (Exception. "The first input must be a datomic DB so that datomic-type-extensions can deserialize."))) 95 | attr->attr-info (find-attr->attr-info db) 96 | has-stats? (boolean (seq (select-keys query-map [:io-context :query-stats]))) 97 | query-result (d/query 98 | (assoc (select-keys query-map [:args :io-context :query-stats]) 99 | :query (query/strip-return-maps query))) 100 | result-set (if has-stats? (:ret query-result) query-result)] 101 | (-> result-set 102 | (query/deserialize-by-pattern 103 | (query/deserialization-pattern query attr->attr-info) 104 | attr->attr-info) 105 | (query/return-maps (query/return-map-keys query)) 106 | (cond->> has-stats? (assoc query-result :ret))))) 107 | 108 | (defn q [q & inputs] 109 | (query {:query q :args inputs})) 110 | 111 | (import-vars [datomic.api 112 | add-listener 113 | as-of 114 | as-of-t 115 | attribute 116 | basis-t 117 | ;; connect - implemented to init the :dte/valueType attr 118 | create-database 119 | datoms 120 | ;; db - implemented to cache attr->attr-info 121 | delete-database 122 | entid 123 | entid-at 124 | ;; entity - wraps datomic.Entity to deserialize attrs when accessed 125 | entity-db 126 | ;; filter - implemented to make sure attr->attr-info is preserved 127 | function 128 | gc-storage 129 | get-database-names 130 | ;; history - implemented to make sure attr->attr-info is available 131 | ident 132 | index-range 133 | invoke 134 | is-filtered 135 | log 136 | next-t 137 | part 138 | ;; pull - implemented to deserialize return value 139 | ;; pull-many - implemented to deserialize return value 140 | ;; q - implemented to deserialize values 141 | ;; query - ditto 142 | release 143 | remove-tx-report-queue 144 | rename-database 145 | request-index 146 | resolve-tempid 147 | seek-datoms 148 | shutdown 149 | ;; since - implemented to keep attr->attr-info on the db 150 | since-t 151 | squuid 152 | squuid-time-millis 153 | sync 154 | sync-excise 155 | sync-index 156 | sync-schema 157 | t->tx 158 | tempid 159 | touch 160 | ;; transact - implemented to serialize values 161 | ;; transact-async - ditto 162 | tx->t 163 | tx-range 164 | tx-report-queue 165 | ;; with - implemented to serialize values 166 | ]) 167 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Datomic type extensions 2 | 3 | 4 | 5 | This Clojure library provides custom types for your Datomic attributes. It does 6 | this by wrapping a leaky abstraction around your regular Datomic API. 7 | 8 | - Add custom types by implementing the `serialize`, `deserialize` and 9 | `get-backing-datomic-type` multimethods in the `datomic-type-extensions.types` 10 | namespace. 11 | 12 | - Require `[datomic-type-extensions.api :as d]` instead of `[datomic.api :as d]`. 13 | 14 | - When you `d/connect` the first time, a `:dte/valueType` attribute will be 15 | installed. 16 | 17 | - Assert `:dte/valueType` for your typed attributes. When transacting attribute 18 | definitions, the original `:db/valueType` will be added by looking it up in 19 | `get-backing-datomic-type`. 20 | 21 | - When using `d/transact`, `d/transact-async` or `d/with`, your typed attributes 22 | will be serialized before being passed to Datomic. 23 | 24 | - When using `d/q`, `d/query`, `d/pull` or `d/pull-many`, your typed attributes will be 25 | deserialized on the way out of Datomic. 26 | 27 | - Entities returned by `d/entity` will lazily deserialize their types. 28 | 29 | Oh, the convenience! 30 | 31 | ### Did you say leaky abstraction? 32 | 33 | Oh yes. Let's look at some ways this abstraction leaks: 34 | 35 | - Database functions see serialized values. 36 | 37 | - Where-clauses in queries see serialized values. 38 | 39 | - Params to queries are not serialized for you. 40 | 41 | - Datoms (as returned by `:tx-data`, indexes, and the log) are not 42 | deserialized. 43 | 44 | There might be more, but during several years of production use, these are the ones we have encountered. 45 | 46 | ### Usage 47 | 48 | Define a custom type: 49 | 50 | ```clj 51 | (require '[datomic-type-extensions.types :as types]) 52 | 53 | (types/define-dte :java.time/instant 54 | 55 | ;; native Datomic backing type 56 | :db.type/instant 57 | 58 | ;; serialize 59 | [^java.time.Instant this] 60 | (java.util.Date/from this) 61 | 62 | ;; deserialize 63 | [^java.util.Date inst] 64 | (java.time.Instant/ofEpochMilli (.getTime inst))) 65 | ``` 66 | 67 | If you're interested in storing [java.time](https://docs.oracle.com/javase/8/docs/api/java/time/package-summary.html) 68 | types in Datomic, use [java-time-dte](https://github.com/magnars/java-time-dte). 69 | 70 | Then use the custom type: 71 | 72 | ```clj 73 | (require '[datomic-type-extensions.api :as d]) 74 | 75 | (defn create-conn [] 76 | (let [url (str "datomic:mem://" (d/squuid))] 77 | (d/create-database url) 78 | (d/connect url))) 79 | 80 | (def conn (create-conn)) 81 | 82 | @(d/transact 83 | conn 84 | [{:db/ident :user/email 85 | :db/valueType :db.type/string 86 | :db/unique :db.unique/identity 87 | :db/cardinality :db.cardinality/one} 88 | {:db/ident :user/created-at 89 | :dte/valueType :java.time/instant ;; here's the typed attribute 90 | :db/cardinality :db.cardinality/one}]) 91 | 92 | @(d/transact 93 | conn 94 | [{:user/email "foo@example.com" 95 | :user/created-at (java.time.Instant/parse "2017-01-01T00:00:00Z")}]) 96 | 97 | (d/pull (d/db conn) 98 | [:user/created-at] 99 | [:user/email "foo@example.com"]) ;; :user/created-at is a java.time.Instant 100 | 101 | (:user/created-at (d/entity (d/db conn) [:user/email "foo@example.com"])) 102 | ;; => returns a java.time.Instant 103 | 104 | (d/q '[:find ?inst . :where [_ :user/created-at ?inst]] 105 | (d/db conn)) ;; so does this 106 | 107 | (let [[[e a v]] 108 | (seq (d/datoms (d/db conn) :eavt [:user/email "foo@example.com"] :user/created-at))] 109 | v) ;; this leaks: it returns a java.util.Date (the serialized backing type) 110 | ``` 111 | 112 | ### So now what? 113 | 114 | Feel free to use it. It's been used for years in several projects. Just be aware 115 | that it is leaky. For me, I hope that one day this entire library will be made 116 | redundant by the Datomic team. 117 | 118 | ### How can I use it with Conformity? 119 | 120 | Since Conformity's `ensure-conforms` transacts for you using the non-wrapped 121 | Datomic API, you can add the backing types like so: 122 | 123 | ```clj 124 | (d/add-backing-types tx-data) 125 | ``` 126 | 127 | before sending the migrations to Conformity. 128 | 129 | If you are also migrating in data that needs to be serialized, you might have to 130 | do the attribute migrations first, and then do: 131 | 132 | ```clj 133 | (d/prepare-tx-data db tx-data) 134 | ``` 135 | 136 | on the data migration. 137 | 138 | ## Install 139 | 140 | With tools.deps: 141 | 142 | ```clj 143 | datomic-type-extensions/datomic-type-extensions {:mvn/version "2025.01.24"} 144 | ``` 145 | 146 | With Leiningen: 147 | 148 | ```clj 149 | [datomic-type-extensions "2025.01.24"] 150 | ``` 151 | 152 | ## Changes 153 | 154 | #### From 2024.11.20 to 2025.01.24 155 | 156 | - Support retractions without a value. ([Tormod Mathiesen](https://github.com/2food)) 157 | - Add support for query-stats and io-stats. 158 | - Add support for return maps in queries. 159 | - Add support for queries as maps. 160 | 161 | #### From 2024.02.09 to 2024.11.20 162 | 163 | - Bugfix: Calling `seq` on an entity now returns a list of `MapEntry` 164 | 165 | This is the expected behavior of datomic entities, and makes it work with `keys`. 166 | 167 | #### From 2024.01.17 to 2024.02.09 168 | 169 | - **BREAKING BUGFIX** 170 | 171 | Data with nested dte-backed attributes was not properly deserialized. This 172 | bug has now been fixed, with potential breakage if your code relied on this 173 | asymmetry. 174 | 175 | More information in the PR: https://github.com/magnars/datomic-type-extensions/pull/9 176 | 177 | #### From 2020-05-26 to 2024.01.17 178 | 179 | - Add `datomic-type-extensions.types/define-dte` macro for even more 180 | convenience. 181 | - Support for linting `define-dte` with clj-kondo. 182 | 183 | #### From 2019-09-04 to 2020-05-26 184 | 185 | - Better performance with type hints to avoid reflection. 186 | 187 | #### From 2019-05-10 to 2019-09-04 188 | 189 | - We now wrap `datomic.api/history` to ensure we cache the type extended 190 | attributes *before* the history db makes us unable to find them. 191 | 192 | #### From 2019-02-05 to 2019-05-10 193 | 194 | - We now wrap `datomic.api/filter` to ensure we cache the type extended 195 | attributes *before* you filter them out of the database. 196 | 197 | #### From 2019-02-05 to 2019-02-18 198 | 199 | Bugfixes: 200 | 201 | - Fix serialization / deserialization of multi-value attributes again 202 | 203 | #### From 2019-01-23 to 2019-02-05 204 | 205 | Bugfixes: 206 | 207 | - Fix lookup of missing serialized attribute. 208 | 209 | #### From 2018-11-06 to 2019-01-23 210 | 211 | Bugfixes: 212 | 213 | - Fix serialization / deserialization of multi-value attributes (i.e. :db.cardinality/many) 214 | 215 | #### From 2018-04-18 to 2018-11-06 216 | 217 | Bugfixes / aligning the APIs with Datomic: 218 | 219 | - Make TypeExtendedEntityMap behave more like Datomic wrt printing (Anders Furseth) 220 | - Hash EntityMap and TypeExtendedEntityMap differently 221 | - Cache the attr-types lookup on db gotten from entity 222 | - Wrap entity when emptied 223 | 224 | ## License 225 | 226 | Copyright © Anders Furseth and Magnar Sveen, since 2018 227 | 228 | Distributed under the Eclipse Public License, the same as Clojure. 229 | -------------------------------------------------------------------------------- /test/datomic_type_extensions/api_test.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-type-extensions.api-test 2 | (:require [clojure.edn :as edn] 3 | [clojure.test :refer [are deftest is testing]] 4 | [datomic-type-extensions.api :as api] 5 | [datomic-type-extensions.core :as core] 6 | [datomic-type-extensions.types :as types] 7 | [datomic.api :as d]) 8 | (:import java.time.Instant)) 9 | 10 | ;; :java.time/instant 11 | 12 | (defmethod types/get-backing-datomic-type :java.time/instant [_] :db.type/instant) 13 | (defmethod types/serialize :java.time/instant [_ ^Instant instant] (java.util.Date/from instant)) 14 | (defmethod types/deserialize :java.time/instant [_ ^java.util.Date inst] (Instant/ofEpochMilli (.getTime inst))) 15 | 16 | ;; :keyword-backed-by-string 17 | 18 | (defmethod types/get-backing-datomic-type :keyword-backed-by-string [_] :db.type/string) 19 | (defmethod types/serialize :keyword-backed-by-string [_ kw] (name kw)) 20 | (defmethod types/deserialize :keyword-backed-by-string [_ s] (keyword s)) 21 | 22 | ;; :edn-backed-by-string 23 | 24 | (defmethod types/get-backing-datomic-type :edn-backed-by-string [_] :db.type/string) 25 | (defmethod types/serialize :edn-backed-by-string [_ x] (pr-str x)) 26 | (defmethod types/deserialize :edn-backed-by-string [_ x] 27 | (clojure.edn/read-string 28 | {:readers {'time/inst java-time-literals.core/parse-instant}} 29 | x)) 30 | 31 | (defn attr-info [value-type & [cardinality]] 32 | {:dte/valueType value-type 33 | :db/cardinality (or cardinality :db.cardinality/one)}) 34 | 35 | (def attr->attr-info 36 | {:user/created-at (attr-info :java.time/instant) 37 | :user/updated-at (attr-info :java.time/instant) 38 | :user/demands (attr-info :keyword-backed-by-string :db.cardinality/many) 39 | :user/edn (attr-info :edn-backed-by-string) 40 | :client/id (attr-info :keyword-backed-by-string)}) 41 | 42 | (deftest apply-to-value 43 | (are [cardinality value result] (= result 44 | (core/apply-to-value 45 | str 46 | {:db/cardinality cardinality} 47 | value)) 48 | :db.cardinality/one 0 "0" 49 | :db.cardinality/one [0 1 2] "[0 1 2]" 50 | :db.cardinality/many [0 1 2] ["0" "1" "2"] 51 | :db.cardinality/many '(0 1 2) '("0" "1" "2") 52 | :db.cardinality/many #{0 1 2} #{"0" "1" "2"}) 53 | 54 | (is (thrown-with-msg? 55 | Exception #"Value must be either set, list or vector" 56 | (core/apply-to-value str 57 | {:db/cardinality :db.cardinality/many} 58 | 1)))) 59 | 60 | (deftest serialize-tx-data 61 | (is (= [{:db/id 123 :user/created-at #inst "2017-01-01T00:00:00"} 62 | [:db/retract 123 :user/updated-at #inst "2017-02-02T00:00:00"] 63 | [:db/retract 123 :user/updated-at] 64 | [:db/add 456 :client/id "the-client"] 65 | [:db/add 123 :user/name "no serialization needed"] 66 | [:db/add 123 :user/demands ["peace" "love" "happiness"]] 67 | [:db/add 123 :user/edn "[1 2 3]"]] 68 | (core/serialize-tx-data 69 | attr->attr-info 70 | [{:db/id 123 :user/created-at #time/inst "2017-01-01T00:00:00Z"} 71 | [:db/retract 123 :user/updated-at #time/inst "2017-02-02T00:00:00Z"] 72 | [:db/retract 123 :user/updated-at] 73 | [:db/add 456 :client/id :the-client] 74 | [:db/add 123 :user/name "no serialization needed"] 75 | [:db/add 123 :user/demands [:peace :love :happiness]] 76 | [:db/add 123 :user/edn [1 2 3]]]))) 77 | 78 | (testing "serialize and deserialize symmetry for nested dte-backed types" 79 | (let [data {:user/edn {:user/created-at #time/inst "2017-01-01T00:00:00Z"}}] 80 | (is (= (core/deserialize attr->attr-info (core/serialize-tx-data attr->attr-info data)) 81 | data)))) 82 | 83 | (testing "nested maps" 84 | (is (= [{:client/users [{:user/created-at #inst "2017-01-01T00:00:00.000-00:00"} 85 | {:user/created-at #inst "2018-01-01T00:00:00.000-00:00"}] 86 | :client/admin {:user/created-at #inst "2016-01-01T00:00:00"}}] 87 | (core/serialize-tx-data 88 | attr->attr-info 89 | [{:client/users [{:user/created-at #time/inst "2017-01-01T00:00:00Z"} 90 | {:user/created-at #time/inst "2018-01-01T00:00:00Z"}] 91 | :client/admin {:user/created-at #time/inst "2016-01-01T00:00:00Z"}}])))) 92 | 93 | (testing "multiple values" 94 | (is (= [{:user/demands ["peace" "love" "happiness"]}] 95 | (core/serialize-tx-data attr->attr-info [{:user/demands [:peace :love :happiness]}])))) 96 | 97 | (testing "edn value" 98 | (is (= [{:user/demands ["peace" "love" "happiness"]}] 99 | (core/serialize-tx-data attr->attr-info [{:user/demands [:peace :love :happiness]}])))) 100 | 101 | (testing "nested tx-data" 102 | (is (= {:conformity {:txs [[[:db/add 456 :client/id "the-client"]]]}} 103 | (core/serialize-tx-data 104 | attr->attr-info 105 | {:conformity {:txs [[[:db/add 456 :client/id :the-client]]]}}))))) 106 | 107 | (deftest serialize-lookup-ref 108 | (is (= 123 (core/serialize-lookup-ref attr->attr-info 123))) 109 | (is (= [:client/id "the-client"] 110 | (core/serialize-lookup-ref attr->attr-info [:client/id :the-client])))) 111 | 112 | (deftest add-backing-types 113 | (is (= [{:db/ident :user/created-at 114 | :db/valueType :db.type/instant 115 | :dte/valueType :java.time/instant 116 | :db/cardinality :db.cardinality/one} 117 | {:db/ident :client/id 118 | :db/unique :db.unique/identity 119 | :db/valueType :db.type/string 120 | :dte/valueType :keyword-backed-by-string 121 | :db/cardinality :db.cardinality/one}] 122 | (api/add-backing-types 123 | [{:db/ident :user/created-at 124 | :dte/valueType :java.time/instant 125 | :db/cardinality :db.cardinality/one} 126 | {:db/ident :client/id 127 | :db/unique :db.unique/identity 128 | :dte/valueType :keyword-backed-by-string 129 | :db/cardinality :db.cardinality/one}])))) 130 | 131 | (defn create-conn [] 132 | (let [url (str "datomic:mem://" (d/squuid))] 133 | (api/create-database url) 134 | (api/connect url))) 135 | 136 | (def migrations 137 | [{:db/ident :user/email 138 | :db/valueType :db.type/string 139 | :db/unique :db.unique/identity 140 | :db/cardinality :db.cardinality/one} 141 | {:db/ident :user/demands 142 | :dte/valueType :keyword-backed-by-string 143 | :db/cardinality :db.cardinality/many} 144 | {:db/ident :user/leaves-empty 145 | :dte/valueType :keyword-backed-by-string 146 | :db/cardinality :db.cardinality/many} 147 | {:db/ident :user/created-at 148 | :dte/valueType :java.time/instant 149 | :db/cardinality :db.cardinality/one} 150 | {:db/ident :user/updated-at 151 | :dte/valueType :java.time/instant 152 | :db/cardinality :db.cardinality/one} 153 | {:db/ident :client/id 154 | :db/unique :db.unique/identity 155 | :dte/valueType :keyword-backed-by-string 156 | :db/cardinality :db.cardinality/one} 157 | {:db/ident :client/users 158 | :db/valueType :db.type/ref 159 | :db/cardinality :db.cardinality/many} 160 | {:db/ident :client/admin 161 | :db/valueType :db.type/ref 162 | :db/cardinality :db.cardinality/one}]) 163 | 164 | (defn create-migrated-conn [] 165 | (let [conn (create-conn)] 166 | (->> migrations 167 | (api/transact conn) 168 | deref) 169 | conn)) 170 | 171 | (deftest find-attr->attr-info 172 | (is (= {:user/created-at (attr-info :java.time/instant) 173 | :user/updated-at (attr-info :java.time/instant) 174 | :user/demands (attr-info :keyword-backed-by-string :db.cardinality/many) 175 | :user/leaves-empty (attr-info :keyword-backed-by-string :db.cardinality/many) 176 | :client/id (attr-info :keyword-backed-by-string)} 177 | (api/find-attr->attr-info (d/db (create-migrated-conn)))))) 178 | 179 | (deftest transact-async 180 | (is (= {:user/created-at #inst "2017-01-01T00:00:00"} 181 | (let [conn (create-migrated-conn)] 182 | (api/transact-async conn 183 | [{:user/email "foo@example.com" 184 | :user/created-at #time/inst "2017-01-01T00:00:00Z"}]) 185 | (d/sync conn) 186 | (d/pull (d/db conn) 187 | [:user/created-at] 188 | [:user/email "foo@example.com"]))))) 189 | 190 | (defn create-populated-conn [] 191 | (let [conn (create-migrated-conn)] 192 | @(api/transact 193 | conn 194 | [{:client/id :the-client 195 | :client/users [{:user/email "foo@example.com" 196 | :user/created-at #time/inst "2017-01-01T00:00:00Z" 197 | :user/demands [:peace :love :happiness]}]}]) 198 | conn)) 199 | 200 | (deftest entity 201 | (let [wrapped-entity (api/entity (d/db (create-populated-conn)) 202 | [:user/email "foo@example.com"])] 203 | (testing "deserializes registered attributes" 204 | (is (= #time/inst "2017-01-01T00:00:00Z" (:user/created-at wrapped-entity))) 205 | (is (= #{:peace :love :happiness} (set (:user/demands wrapped-entity))))) 206 | 207 | (testing "leaves unregistered attributes alone" 208 | (is (= "foo@example.com" (:user/email wrapped-entity)))) 209 | 210 | (testing "implements Associative" 211 | (is (= {:user/created-at #time/inst "2017-01-01T00:00:00Z" 212 | :user/email "foo@example.com"} 213 | (select-keys wrapped-entity #{:user/created-at :user/email :client/id :foo/bar})))) 214 | 215 | (testing "implements ILookup" 216 | (is (= (.valAt wrapped-entity :user/email) "foo@example.com")) 217 | (is (= (.valAt wrapped-entity :user/email :not-found) "foo@example.com")) 218 | (is (nil? (.valAt wrapped-entity :user/missing-attr))) 219 | (is (= (.valAt wrapped-entity :user/missing-attr :not-found) :not-found)) 220 | (is (nil? (.valAt wrapped-entity :user/leaves-empty)))) 221 | 222 | (testing "works with (keys ,,,)" 223 | (is (= (set (keys wrapped-entity)) 224 | #{:user/email :user/demands :user/created-at}))) 225 | 226 | (testing "keeps type when emptied" 227 | (is (= wrapped-entity (empty wrapped-entity))))) 228 | 229 | (testing "can use entity lookup ref" 230 | (is (not (nil? (api/entity (d/db (create-populated-conn)) 231 | [:client/id :the-client]))))) 232 | 233 | (let [db (d/db (create-populated-conn)) 234 | datomic-entity (d/entity db [:client/id "the-client"]) 235 | wrapped-entity (api/entity db [:client/id :the-client])] 236 | 237 | (testing "equality semantics" 238 | (is (not= datomic-entity wrapped-entity)) 239 | (is (not= wrapped-entity datomic-entity)) 240 | (is (= wrapped-entity (api/entity db [:client/id :the-client])))) 241 | 242 | (testing "deserializes nested entity attributes" 243 | (is (= #time/inst "2017-01-01T00:00:00Z" 244 | (-> wrapped-entity :client/users first :user/created-at)))) 245 | 246 | (testing "printing" 247 | (testing "defaults to only show :db/id" 248 | (is (= (let [client-db-id (:db/id datomic-entity)] 249 | {:db/id client-db-id}) 250 | (edn/read-string (pr-str wrapped-entity))))) 251 | 252 | (testing "shows all attributes when entity has been touched" 253 | (is (= (let [client-db-id (:db/id datomic-entity) 254 | user-db-id (:db/id (first (:client/users datomic-entity)))] 255 | {:client/id :the-client 256 | :client/users #{{:db/id user-db-id}} 257 | :db/id client-db-id}) 258 | (edn/read-string {:readers *data-readers*} 259 | (pr-str (d/touch wrapped-entity)))))) 260 | 261 | (testing "shows deserialized value of type extended attributes" 262 | (is (= {:db/id (:db/id (first (:client/users datomic-entity))) 263 | :user/created-at #time/inst "2017-01-01T00:00:00Z" 264 | :user/email "foo@example.com" 265 | :user/demands #{:peace :love :happiness}} 266 | (edn/read-string {:readers *data-readers*} 267 | (pr-str (d/touch (first (:client/users wrapped-entity))))))))) 268 | 269 | (testing "hashes differently" 270 | (is (not= (hash datomic-entity) 271 | (hash wrapped-entity)))))) 272 | 273 | (deftest pull 274 | (is (= {:client/users [{:user/created-at #time/inst "2017-01-01T00:00:00Z"}]} 275 | (api/pull (d/db (create-populated-conn)) 276 | [{:client/users [:user/created-at]}] 277 | [:client/id :the-client]))) 278 | 279 | (is (= [{:client/id :the-client 280 | :client/users [{:user/created-at #time/inst "2017-01-01T00:00:00Z"}]}] 281 | (api/pull-many (d/db (create-populated-conn)) 282 | [:client/id {:client/users [:user/created-at]}] 283 | [[:client/id :the-client]])))) 284 | 285 | (deftest since 286 | (let [conn (create-migrated-conn) 287 | t (d/basis-t (d/db conn)) 288 | _ (api/transact conn [{:user/email "bar@example.com" 289 | :user/created-at #time/inst "2018-01-01T00:00:00Z"}]) 290 | db-since (api/since (d/db conn) t)] 291 | (is (= #time/inst "2018-01-01T00:00:00Z" 292 | (:user/created-at (api/entity db-since [:user/email "bar@example.com"])))) 293 | (is (= db-since 294 | (api/entity-db (api/entity db-since [:user/email "bar@example.com"])))))) 295 | 296 | (deftest with 297 | (is (= {:client/users [{:user/created-at #time/inst "2017-01-01T00:00:00Z"} 298 | {:user/created-at #time/inst "2017-02-01T00:00:00Z"}]} 299 | (api/pull (:db-after (api/with (d/db (create-populated-conn)) 300 | [{:client/id :the-client 301 | :client/users [{:user/email "bar@example.com" 302 | :user/created-at #time/inst "2017-02-01T00:00:00Z"}]}])) 303 | [{:client/users [:user/created-at]}] 304 | [:client/id :the-client])))) 305 | 306 | (deftest filter 307 | (is (= {:client/id :the-client 308 | :client/users [{:user/created-at #time/inst "2017-01-01T00:00:00Z"}]} 309 | (let [db (d/db (create-populated-conn)) 310 | the-client (api/entity db [:client/id :the-client]) 311 | keep-eids (into #{(:db/id the-client)} 312 | (map :db/id (:client/users the-client)))] 313 | (api/pull (api/filter db (fn [_ datom] (some #{(:e datom)} keep-eids))) 314 | [:client/id {:client/users [:user/created-at]}] 315 | (:db/id the-client)))))) 316 | 317 | (deftest history 318 | (let [conn (create-populated-conn) 319 | db (d/db conn) 320 | the-user (api/entity db [:user/email "foo@example.com"]) 321 | changed-db (:db-after @(api/transact conn [{:user/email "foo@example.com" 322 | :user/created-at #time/inst "2018-01-01T00:00:00Z"}]))] 323 | (is (= 3 324 | (count 325 | (api/q '[:find ?created-at ?tx ?op 326 | :in $ ?user 327 | :where 328 | [?user :user/created-at ?created-at ?tx ?op]] 329 | (api/history changed-db) 330 | (:db/id the-user))))))) 331 | 332 | (deftest q 333 | (is (= #{[#time/inst "2017-01-01T00:00:00Z"]} 334 | (api/q 335 | '[:find ?inst :where [_ :user/created-at ?inst]] 336 | (d/db (create-populated-conn))))) 337 | 338 | (is (= #{[:the-client {:user/created-at #time/inst "2017-01-01T00:00:00.000Z"}]} 339 | (api/q '[:find ?c-id (pull ?e [:user/created-at]) 340 | :where 341 | [?c :client/id ?c-id] 342 | [?c :client/users ?e]] 343 | (d/db (create-populated-conn))))) 344 | 345 | (is (= #{[#time/inst "2017-01-01T00:00:00Z"]} 346 | (api/query 347 | {:query '[:find ?inst :where [_ :user/created-at ?inst]] 348 | :args [(d/db (create-populated-conn))]}))) 349 | 350 | (is (thrown-with-msg? Exception #"The first input must be a datomic DB so that datomic-type-extensions can deserialize." 351 | (api/q '[:find ?inst :in ?e $ :where [?e :user/created-at ?inst]] 352 | [:user/email "foo@example.com"] (d/db (create-populated-conn))))) 353 | 354 | (testing "Return Maps" 355 | ;; Return maps is a datomic feature that allows a query to return a sequence of maps. 356 | ;; 357 | ;; Datomic docs for return maps: https://docs.datomic.com/query/query-data-reference.html#return-maps 358 | (is (= '({:created-at #time/inst "2017-01-01T00:00:00.000-00:00" 359 | :email "foo@example.com"}) 360 | (api/q '[:find ?created-at ?email 361 | :keys created-at email 362 | :where 363 | [?e :user/email ?email] 364 | [?e :user/created-at ?created-at]] 365 | (d/db (create-populated-conn))))))) 366 | 367 | (deftest stats 368 | (testing "Query stats returns map with result set in :ret" 369 | (let [result (api/query 370 | {:query '[:find ?inst :where [_ :user/created-at ?inst]] 371 | :args [(d/db (create-populated-conn))] 372 | :query-stats true})] 373 | (is (= #{[#time/inst "2017-01-01T00:00:00Z"]} 374 | (:ret result))) 375 | (is (some? (:query-stats result))))) 376 | (testing "IO stats returns map with result set in :ret" 377 | (let [result (api/query 378 | {:query '[:find ?inst :where [_ :user/created-at ?inst]] 379 | :args [(d/db (create-populated-conn))] 380 | :io-context :user/created-at})] 381 | (is (= #{[#time/inst "2017-01-01T00:00:00Z"]} 382 | (:ret result))) 383 | (is (some? (:io-stats result)))))) 384 | 385 | (comment 386 | (set! *print-namespace-maps* false) 387 | 388 | (def conn (create-populated-conn)) 389 | (def db (d/db conn)) 390 | 391 | (d/pull (d/db conn) 392 | [:user/created-at] 393 | [:user/email "foo@example.com"]) 394 | 395 | (d/q '[:find (pull ?e [:user/created-at]) :where [?e :user/email]] db) 396 | (api/q '[:find (pull ?c [:client/id]) (pull ?e [:user/created-at]) 397 | :where 398 | [?c :client/id] 399 | [?c :client/users ?e]] db) 400 | 401 | (d/q '[:find ?c-id (pull ?e [:user/created-at]) 402 | :where 403 | [?c :client/id ?c-id] 404 | [?c :client/users ?e]] db) 405 | 406 | (d/q '[:find [(pull ?e [:user/created-at]) ...] :where [?e :user/email]] db) 407 | 408 | (d/q '[:find (pull ?e [:user/created-at]) . :where [?e :user/email]] db) 409 | 410 | (d/q '[:find [?v ...] :where [?e :client/id ?v]] db) 411 | 412 | (let [[[e a v]] 413 | (seq (d/datoms (d/db conn) :eavt [:user/email "foo@example.com"] :user/created-at))] 414 | v) 415 | 416 | ;; Return maps behavior in Datomic and datomic-type-extensions 417 | (api/q '[:find ?email ?created-at 418 | :where 419 | [?e :user/email ?email] 420 | [?e :user/created-at ?created-at]] 421 | db) 422 | ;; => #{["foo@example.com" #time/inst "2017-01-01T00:00:00Z"]} 423 | 424 | (api/q '{:find [?email ?created-at] 425 | :keys [email created-at] 426 | :where 427 | [[?e :user/email ?email] 428 | [?e :user/created-at ?created-at]]} 429 | db) 430 | ;; => [{:email "foo@example.com", :created-at #time/inst "2017-01-01T00:00:00Z"}] 431 | 432 | (d/q '{:find [?email ?created-at] 433 | :keys [email created-at] 434 | :where 435 | [[?e :user/email ?email] 436 | [?e :user/created-at ?created-at]]} 437 | db) 438 | ;; => [{:email "foo@example.com", :created-at #inst "2017-01-01T00:00:00.000-00:00"}] 439 | 440 | ) 441 | --------------------------------------------------------------------------------