├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── TODO.md ├── dev-resources └── logback-test.xml ├── examples └── mbrainz.clj ├── project.clj ├── src └── datomic_q_explain │ └── core.clj └── test └── datomic_q_explain ├── core_test.clj └── test_select_index.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: clojure 3 | lein: lein2 4 | branches: 5 | only: 6 | - master 7 | cache: 8 | directories: 9 | - $HOME/.m2/repository 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of Washington and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # datomic-q-explain [![Build Status](https://travis-ci.org/dwhjames/datomic-q-explain.svg?branch=master)](https://travis-ci.org/dwhjames/datomic-q-explain) 2 | 3 | A Clojure library to explain the consumption of datoms during query 4 | evaluation. It provides a drop-in replacement for 5 | [Datomic](http://www.datomic.com/)'s `q` function called `q-explain`, 6 | which returns an explanation of the query, rather than the original 7 | query result. The explanation is a breakdown of the number of datoms 8 | consumed by each `:where` clause and the index these datoms were drawn 9 | from. 10 | 11 | Some examples using the 12 | [Datomic mbrainz example database](https://github.com/Datomic/mbrainz-sample) 13 | and the 14 | [sample queries](https://github.com/Datomic/mbrainz-sample/wiki/Queries) 15 | are available in [mbrainz.clj](examples/mbrainz.clj) in the 16 | [examples folder](examples). 17 | 18 | This library is still in early development; see the list of 19 | outstanding [TODOs](TODO.md) for current limitations and future plans. 20 | 21 | ## License 22 | 23 | Copyright © 2014 Daniel W. H. James 24 | 25 | Distributed under the Eclipse Public License either version 1.0 or (at 26 | your option) any later version. 27 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | 2 | - built-in expression functions and predicates 3 | - log api in query 4 | - precompile expression clauses 5 | -------------------------------------------------------------------------------- /dev-resources/logback-test.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | %-4relative [%thread] %-5level %logger{35} - %msg %n 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /examples/mbrainz.clj: -------------------------------------------------------------------------------- 1 | (require '[datomic.api :as d]) 2 | (require '[datomic-q-explain.core :as explain]) 3 | 4 | (def uri "datomic:free://localhost:4334/mbrainz") 5 | (def conn (d/connect uri)) 6 | 7 | (def db (d/db conn)) 8 | 9 | 10 | ;; Queries taken from 11 | ;; https://github.com/Datomic/mbrainz-sample/wiki/Queries 12 | 13 | 14 | (d/q 15 | '[:find ?id ?type ?gender 16 | :in $ ?name 17 | :where 18 | [?e :artist/name ?name] 19 | [?e :artist/gid ?id] 20 | [?e :artist/type ?type] 21 | [?e :artist/gender ?gender]] 22 | db "Lupe Fiasco") 23 | 24 | 25 | (explain/q-explain 26 | '[:find ?id ?type ?gender 27 | :in $ ?name 28 | :where 29 | [?e :artist/name ?name] 30 | [?e :artist/gid ?id] 31 | [?e :artist/type ?type] 32 | [?e :artist/gender ?gender]] 33 | db 34 | "Lupe Fiasco") 35 | 36 | 37 | (d/q 38 | '[:find (count ?title) 39 | :in $ ?artist-name 40 | :where 41 | [?a :artist/name ?artist-name] 42 | [?t :track/artists ?a] 43 | [?t :track/name ?title]] 44 | db "John Lennon") 45 | 46 | (explain/q-explain 47 | '[:find (count ?title) 48 | :in $ ?artist-name 49 | :where 50 | [?a :artist/name ?artist-name] 51 | [?t :track/artists ?a] 52 | [?t :track/name ?title]] 53 | db "John Lennon") 54 | 55 | 56 | (count 57 | (d/q 58 | '[:find ?title ?album ?year 59 | :in $ ?artist-name 60 | :where 61 | [?a :artist/name ?artist-name] 62 | [?t :track/artists ?a] 63 | [?t :track/name ?title] 64 | [?m :medium/tracks ?t] 65 | [?r :release/media ?m] 66 | [?r :release/name ?album] 67 | [?r :release/year ?year]] 68 | db "John Lennon")) 69 | 70 | 71 | (explain/q-explain 72 | '[:find ?title ?album ?year 73 | :in $ ?artist-name 74 | :where 75 | [?a :artist/name ?artist-name] 76 | [?t :track/artists ?a] 77 | [?t :track/name ?title] 78 | [?m :medium/tracks ?t] 79 | [?r :release/media ?m] 80 | [?r :release/name ?album] 81 | [?r :release/year ?year]] 82 | db "John Lennon") 83 | 84 | 85 | (count 86 | (d/q 87 | '[:find ?title ?album ?year 88 | :in $ ?artist-name 89 | :where 90 | [?a :artist/name ?artist-name] 91 | [?t :track/artists ?a] 92 | [?t :track/name ?title] 93 | [?m :medium/tracks ?t] 94 | [?r :release/media ?m] 95 | [?r :release/name ?album] 96 | [?r :release/year ?year] 97 | [(<= ?year 1980)]] 98 | db "John Lennon")) 99 | 100 | 101 | (explain/q-explain 102 | '[:find ?title ?album ?year 103 | :in $ ?artist-name 104 | :where 105 | [?a :artist/name ?artist-name] 106 | [?t :track/artists ?a] 107 | [?t :track/name ?title] 108 | [?m :medium/tracks ?t] 109 | [?r :release/media ?m] 110 | [?r :release/name ?album] 111 | [?r :release/year ?year] 112 | [(<= ?year 1980)]] 113 | db "John Lennon") 114 | 115 | 116 | (def simple-rules 117 | '[;; Given ?t bound to track entity-ids, binds ?r to the corresponding 118 | ;; set of album release entity-ids 119 | [(track-release ?t ?r) 120 | [?m :medium/tracks ?t] 121 | [?r :release/media ?m]] 122 | 123 | ;; Supply track entity-ids as ?t, and the other parameters will be 124 | ;; bound to the corresponding information about the tracks 125 | [(track-info ?t ?track-name ?artist-name ?album ?year) 126 | [?t :track/name ?track-name] 127 | [?t :track/artists ?a] 128 | [?a :artist/name ?artist-name] 129 | (track-release ?t ?r) 130 | [?r :release/name ?album] 131 | [?r :release/year ?year]]]) 132 | 133 | 134 | (count 135 | (d/q 136 | '[:find ?title ?album ?year 137 | :in $ % ?artist-name 138 | :where 139 | [?a :artist/name ?artist-name] 140 | [?t :track/artists ?a] 141 | [?t :track/name ?title] 142 | (track-release ?t ?r) 143 | [?r :release/name ?album] 144 | [?r :release/year ?year]] 145 | db simple-rules "John Lennon")) 146 | 147 | 148 | (explain/q-explain 149 | '[:find ?title ?album ?year 150 | :in $ % ?artist-name 151 | :where 152 | [?a :artist/name ?artist-name] 153 | [?t :track/artists ?a] 154 | [?t :track/name ?title] 155 | (track-release ?t ?r) 156 | [?r :release/name ?album] 157 | [?r :release/year ?year]] 158 | db simple-rules "John Lennon") 159 | 160 | 161 | (count 162 | (d/q 163 | '[:find ?artist ?rname ?type 164 | :in $ ?aname 165 | :where 166 | [?a :artist/name ?aname] 167 | [?ar :abstractRelease/artists ?a] 168 | [?ar :abstractRelease/name ?rname] 169 | [?ar :abstractRelease/artistCredit ?artist] 170 | [?ar :abstractRelease/type ?type-e] 171 | [?type-e :db/ident ?type]] 172 | db "The Beatles")) 173 | 174 | 175 | (explain/q-explain 176 | '[:find ?artist ?rname ?type 177 | :in $ ?aname 178 | :where 179 | [?a :artist/name ?aname] 180 | [?ar :abstractRelease/artists ?a] 181 | [?ar :abstractRelease/name ?rname] 182 | [?ar :abstractRelease/artistCredit ?artist] 183 | [?ar :abstractRelease/type ?type-e] 184 | [?type-e :db/ident ?type]] 185 | db "The Beatles") 186 | 187 | 188 | (def collab-rules 189 | '[;; Generic transitive network walking, used by collaboration network 190 | ;; rule below 191 | 192 | ;; Supply: 193 | ;; ?e1 -- an entity-id 194 | ;; ?attr -- an attribute ident 195 | ;; and ?e2 will be bound to entity-ids such that ?e1 and ?e2 are both 196 | ;; values of the given attribute for some entity (?x) 197 | [(transitive-net-1 ?attr ?e1 ?e2) 198 | [?x ?attr ?e1] 199 | [?x ?attr ?e2] 200 | [(not= ?e1 ?e2)]] 201 | 202 | ;; Same as transitive-net-1, but search one more level of depth. We 203 | ;; define this rule twice, once for each case, and the rule 204 | ;; represents the union of the two cases: 205 | ;; - The entities are directly related via the attribute 206 | ;; - The entities are related to the given depth (in this case 2) via the attribute 207 | [(transitive-net-2 ?attr ?e1 ?e2) 208 | (transitive-net-1 ?attr ?e1 ?e2)] 209 | [(transitive-net-2 ?attr ?e1 ?e2) 210 | (transitive-net-1 ?attr ?e1 ?x) 211 | (transitive-net-1 ?attr ?x ?e2) 212 | [(not= ?e1 ?e2)]] 213 | 214 | ;; Artist collaboration graph-walking rules, based on generic 215 | ;; graph-walk rule above 216 | 217 | ;; Supply an artist name as ?artist-name-1, an ?artist-name-2 will be 218 | ;; bound to the names of artists who directly collaborated with the 219 | ;; artist(s) having that name 220 | [(collab ?artist-name-1 ?artist-name-2) 221 | [?a1 :artist/name ?artist-name-1] 222 | (transitive-net-1 :track/artists ?a1 ?a2) 223 | [?a2 :artist/name ?artist-name-2]] 224 | 225 | ;; Alias for collab 226 | [(collab-net-1 ?artist-name-1 ?artist-name-2) 227 | (collab ?artist-name-1 ?artist-name-2)] 228 | 229 | ;; Collaboration network walk to depth 2 230 | [(collab-net-2 ?artist-name-1 ?artist-name-2) 231 | [?a1 :artist/name ?artist-name-1] 232 | (transitive-net-2 :track/artists ?a1 ?a2) 233 | [?a2 :artist/name ?artist-name-2]]]) 234 | 235 | 236 | (count 237 | (d/q 238 | '[:find ?aname2 239 | :in $ % ?aname 240 | :where (collab-net-2 ?aname ?aname2)] 241 | db collab-rules "Paul McCartney")) 242 | 243 | 244 | (explain/q-explain 245 | '[:find ?aname2 246 | :in $ % ?aname 247 | :where (collab-net-2 ?aname ?aname2)] 248 | db collab-rules "Paul McCartney") 249 | 250 | 251 | (d/q 252 | '[:find ?aname (count ?e) 253 | :with ?a 254 | :in $ ?criterion [?aname ...] 255 | :where 256 | [?a :artist/name ?aname] 257 | [?e ?criterion ?a]] 258 | db :abstractRelease/artists ["Jay-Z" "Beyoncé Knowles"]) 259 | 260 | 261 | (explain/q-explain 262 | '[:find ?aname (count ?e) 263 | :with ?a 264 | :in $ ?criterion [?aname ...] 265 | :where 266 | [?a :artist/name ?aname] 267 | [?e ?criterion ?a]] 268 | db :abstractRelease/artists ["Jay-Z" "Beyoncé Knowles"]) 269 | 270 | 271 | (count 272 | (d/q 273 | '[:find ?aname ?tname 274 | :in $ ?artist-name 275 | :where 276 | [?a :artist/name ?artist-name] 277 | [?t :track/artists ?a] 278 | [?t :track/name ?tname] 279 | [(not= "Outro" ?tname)] 280 | [(not= "[outro]" ?tname)] 281 | [(not= "Intro" ?tname)] 282 | [(not= "[intro]" ?tname)] 283 | [?t2 :track/name ?tname] 284 | [?t2 :track/artists ?a2] 285 | [(not= ?a2 ?a)] 286 | [?a2 :artist/name ?aname]] 287 | db "The Who")) 288 | 289 | (explain/q-explain 290 | '[:find ?aname ?tname 291 | :in $ ?artist-name 292 | :where 293 | [?a :artist/name ?artist-name] 294 | [?t :track/artists ?a] 295 | [?t :track/name ?tname] 296 | [(not= "Outro" ?tname)] 297 | [(not= "[outro]" ?tname)] 298 | [(not= "Intro" ?tname)] 299 | [(not= "[intro]" ?tname)] 300 | [?t2 :track/name ?tname] 301 | [?t2 :track/artists ?a2] 302 | [(not= ?a2 ?a)] 303 | [?a2 :artist/name ?aname]] 304 | db "The Who") 305 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject datomic-q-explain "0.1.0-SNAPSHOT" 2 | :description "A query explainer for Datomic" 3 | :url "https://github.com/dwhjames/datomic-q-explain" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.6.0"] 7 | [com.datomic/datomic-free "0.9.4894" 8 | :exclusions [org.clojure/clojure 9 | org.slf4j/slf4j-log4j12 10 | org.slf4j/slf4j-nop]] 11 | [ch.qos.logback/logback-classic "1.1.2"]] 12 | :jvm-opts ["-Xms1g" "-Xmx1g"]) 13 | -------------------------------------------------------------------------------- /src/datomic_q_explain/core.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-q-explain.core 2 | (:require [datomic.api :as d])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | 7 | (defn compute-index-traversal 8 | "Determine which index to use and how to traverse it, 9 | given a query `:where` clause `clause` and 10 | an evaluation context `ctx`. 11 | 12 | The functions `is-ref-attr?` and `has-index?` are 13 | invoked to determine the `:vaet` and `:avet` indexes 14 | can be used, respectively. 15 | 16 | This function returns a triple, of the index keyword 17 | (one of `:eavt`, `:aevt`, `:avet`, or `:vaet`), the 18 | fixed components to apply to the index lookup, and 19 | an optional predicate that if non-nil should be used 20 | to filter the datoms that a returned from an index 21 | traversal. 22 | 23 | Example: 24 | (let [[index components filter-fn] (compute-index-traversal ...) 25 | ds (seq (apply d/datoms index components))] 26 | (if filter-fn (filter filter-fn ds) ds)) 27 | " 28 | [is-ref-attr? has-index? ctx clause] 29 | (let [;; extract the symbols from the clause 30 | [e-sym a-sym v-sym t-sym] clause 31 | ;; look up symbols in context 32 | e (get ctx e-sym) 33 | a (get ctx a-sym) 34 | v (get ctx v-sym) 35 | t (get ctx t-sym)] 36 | (if e 37 | ;; ?e is bound 38 | (if a 39 | ;; ?e and ?a are bound 40 | (if v 41 | ;; ?e ?a and ?v are bound 42 | (if t 43 | ;; only ?e ?a ?v and ?t are bound 44 | [:eavt [e a v t] nil] 45 | ;; only ?e ?a and ?v are bound 46 | [:eavt [e a v] nil]) 47 | ;; ?e and ?a are bound, not ?v 48 | (if t 49 | ;; ?e ?a and ?t are bound, not ?v 50 | [:eavt [e a] #(= t (:tx %))] 51 | ;; only ?e and ?a are bound 52 | [:eavt [e a] nil])) 53 | ;; ?e is bound and ?a is not bound 54 | (if v 55 | ;; ?e and ?v are bound, not ?a 56 | (if t 57 | ;; only ?e ?v and ?t are bound 58 | [:eavt [e] 59 | ;; filter for ?v and ?t 60 | #(and (= v (:v %)) 61 | (= t (:tx %)))] 62 | ;; only ?e and ?v are bound 63 | [:eavt [e] 64 | ;; filter for ?v 65 | #(= v (:v %))]) 66 | ;; ?e is bound, not ?a or ?v 67 | (if t 68 | ;; only ?e and ?t are bound 69 | [:eavt [e] 70 | ;; filter for ?t 71 | #(= t (:tx %))] 72 | ;; only ?e is bound 73 | [:eavt [e] nil]))) 74 | ;; ?e is not bound 75 | (if a 76 | ;; ?a is bound, not ?e 77 | (if v 78 | ;; ?a and ?v are bound 79 | (cond 80 | (is-ref-attr? a) ;; if attr is ref type 81 | (if t 82 | ;; only ?a ?v and ?t are bound 83 | [:vaet [v a] 84 | ;; filter for ?t 85 | #(= t (:tx %))] 86 | ;; only ?a and ?v are bound 87 | [:vaet [v a] nil]) 88 | (has-index? a) ;; if attr has index 89 | (if t 90 | ;; only ?a ?v and ?t are bound 91 | [:avet [a v] 92 | ;; filter for t 93 | #(= t (:tx %))] 94 | ;; only ?a and ?v are bound 95 | [:avet [a v] nil]) 96 | :else 97 | (if t 98 | ;; only ?a ?v and ?t are bound 99 | [:aevt [a] 100 | ;; filter for ?v and ?t 101 | #(and (= v (:v %)) 102 | (= t (:tx %)))] 103 | ;; only ?a and ?v are bound 104 | [:aevt [a] 105 | ;; filter for ?v 106 | #(= v (:v %))])) 107 | ;; ?a is bound, not ?e or ?v 108 | (if t 109 | ;; only ?a and ?t are bound 110 | [:aevt [a] 111 | #(= t (:tx %))] 112 | ;; only ?a is bound 113 | [:aevt [a] nil])) 114 | ;; neither ?e nor ?a are bound 115 | (if v 116 | ;; ?v is bound, not ?e or ?a 117 | ;; proceed assuming that the value bound to ?v 118 | ;; is either an entity id or ident, so we will 119 | ;; look in the reverse index 120 | (if t 121 | ;; only ?v and ?t are bound 122 | [:vaet [v] 123 | ;; filter for ?t 124 | #(= t (:tx %))] 125 | ;; only ?v is bound 126 | [:vaet [v] nil]) 127 | ;; neither ?e ?a nor ?v are bound 128 | (throw (IllegalArgumentException. "not enough bound variables"))))))) 129 | 130 | 131 | (defn- bind-query-vars 132 | "Bind query variables to values extracted from a datom. 133 | 134 | Evaluation context `ctx` is extended with variables `k` 135 | bound to values extract by functions `f` from datom `d`." 136 | [ctx d f k & fks] 137 | (let [ret (assoc ctx k (f d))] 138 | (if fks 139 | (recur ret d (first fks) (second fks) (nnext fks)) 140 | ret))) 141 | 142 | 143 | (defn bind-datoms 144 | "Bind a collection datoms `ds` to the variables in a `:where` 145 | clause `clause`, producing a lazy sequence of new evaluation 146 | contexts extends from `ctx`. 147 | 148 | It is assumed that `clause` is already fully abstracted, so 149 | it consists only of variables and no literals. Values are 150 | only extracted for unbound variables (and wildcards are skipped). 151 | 152 | Note: the `:added` value of a datom is currently ignored. 153 | The rationale is that this can't have an impact of datoms 154 | consumption in a query." 155 | [ctx clause ds] 156 | (when (seq ds) 157 | (let [bind-args 158 | (->> clause 159 | (map vector [:e :a :v :tx]) ;; zip with keyword accessors 160 | (filter (fn [[a b]] ;; only keep pairs for unbound vars 161 | (not (or (contains? ctx b) 162 | (= '_ b))))) 163 | (apply concat))] 164 | (if (seq bind-args) ;; shortcut traversal if there is nothing to bind 165 | (map #(apply bind-query-vars ctx % bind-args) ds) 166 | (list ctx))))) 167 | 168 | 169 | (defn is-expression-clause? 170 | "A clause is an expression clause if the first 171 | element is a list." 172 | [clause] 173 | (-> clause first list?)) 174 | 175 | 176 | (defn is-rule-invocation? 177 | "A clause is a rule invocation if the first element 178 | is a symbolic name (not a query or db var, or wildcard), or 179 | if the second is a symblic name and the first is a 180 | database variable (symbol beginning with `$`)." 181 | [clause] 182 | (let [[a b] clause] 183 | (and (symbol? a) 184 | (or (and (-> a name first (= \$)) 185 | (symbol? b) 186 | (-> b name first #{\? \_} not)) 187 | (-> a name first #{\? \_ \$} not))))) 188 | 189 | 190 | (defn abstract-with-fresh-vars 191 | "Extend the evaluation context `ctx` with new query vars 192 | for elements of `coll` that are not already query var, 193 | db vars, or wildcards. Return the new context and the 194 | abstracted collection." 195 | [ctx coll] 196 | (loop [ctx ctx 197 | coll coll 198 | acc []] 199 | (if-let [x (first coll)] 200 | (if (and (symbol? x) 201 | (-> x name first #{\? \_ \$})) 202 | (recur ctx 203 | (rest coll) 204 | (conj acc x)) 205 | (let [s (gensym "?")] 206 | (recur (assoc ctx s x) 207 | (rest coll) 208 | (conj acc s)))) 209 | [ctx acc]))) 210 | 211 | 212 | (defn extract-query-vars 213 | "Return the set of query and db variables that 214 | exists anywhere in the expression body." 215 | [body] 216 | (cond 217 | (and (symbol? body) 218 | (-> body name first #{\? \$})) 219 | #{body} 220 | (coll? body) 221 | (apply clojure.set/union (map extract-query-vars body)))) 222 | 223 | 224 | (defn expr-to-fn 225 | "Precompile an expression body into a function that 226 | evaluates the expression given an eval context." 227 | [body] 228 | (let [vars (->> body 229 | extract-query-vars 230 | (into [])) 231 | f (eval (list 'fn vars 232 | body))] 233 | (fn [ctx] 234 | (->> vars 235 | (map #(get ctx %)) 236 | (apply f))))) 237 | 238 | 239 | (defn abstract-clause 240 | "Extend the evaluation context `ctx` by abstracting the 241 | `:where` clause `clause`, returning a pair of the new 242 | context and the new clause. 243 | 244 | The abstracted clause is prepended with the clause type, 245 | either `:expr`, `:rule`, or `:data`. 246 | 247 | Expression clauses are not abstracted, and rule invocations 248 | are handled specially to avoid abstracting the rule name." 249 | [ctx clause] 250 | (cond 251 | (is-expression-clause? clause) 252 | (let [[body binding] clause 253 | expr-f (expr-to-fn body)] 254 | [ctx [:expr expr-f binding]]) 255 | (is-rule-invocation? clause) 256 | (if (-> clause first name first (= \$)) 257 | (let [[db-var rule-name & args] clause 258 | [ctx1 abstract-args] (abstract-with-fresh-vars ctx args)] 259 | [ctx1 260 | (->> abstract-args 261 | (cons rule-name) 262 | (cons db-var) 263 | (cons :rule))]) 264 | (let [[rule-name & args] clause 265 | [ctx1 abstract-args] (abstract-with-fresh-vars ctx args)] 266 | [ctx1 267 | (->> abstract-args 268 | (cons rule-name) 269 | (cons :rule))])) 270 | :else 271 | (let [[ctx1 abstract-clause] (abstract-with-fresh-vars ctx clause)] 272 | [ctx1 (cons :data abstract-clause)]))) 273 | 274 | 275 | (defn abstract-clauses 276 | "Extends the evaluation context `ctx` by abstracting the 277 | `:where` clauses `clauses`, returning a pair of the new 278 | context and the new clauses." 279 | [ctx clauses] 280 | (loop [ctx ctx 281 | clauses clauses 282 | acc []] 283 | (if (seq clauses) 284 | (let [[ctx1 clause1] (abstract-clause ctx (first clauses))] 285 | (recur ctx1 (rest clauses) (conj acc clause1))) 286 | [ctx acc]))) 287 | 288 | 289 | (defn lookup-db-for-clause 290 | "Determine the appropriate database value to use for the 291 | given `clause`. If the clause's first element specifies 292 | a database variable, then that database is looked up in 293 | `ctx`, otherwise the default database value is used, the 294 | one bound to `$`." 295 | [ctx clause] 296 | (let [first-sym (first clause) 297 | get-db (fn [db-sym] 298 | (if-let [db (get ctx db-sym)] 299 | db 300 | (throw (IllegalArgumentException. 301 | (str "no database is bound for symbol " db-sym)))))] 302 | (if (and (symbol? first-sym) 303 | (-> first-sym 304 | name 305 | first 306 | (= \$))) 307 | [(get-db first-sym) (subvec clause 1)] 308 | [(get-db '$) clause]))) 309 | 310 | 311 | (defn is-ref-attr? 312 | "Test if the given attribute `attr` has a value type of ref." 313 | [db attr] 314 | (-> db 315 | (d/entity attr) 316 | :db/valueType 317 | (= :db.type/ref))) 318 | 319 | 320 | (defn has-index? 321 | "Test if the given attribute `attr` has either an index 322 | or a uniqueness constraint." 323 | [db attr] 324 | (let [e (d/entity db attr)] 325 | (or (:db/index e) 326 | (:db/unique e)))) 327 | 328 | 329 | (defn bind-binding 330 | "Bind `value` according to `binding` to produce a 331 | non-empty list of eval contexts extended from `ctx`." 332 | [ctx binding value] 333 | (cond 334 | ;; scalar binding 335 | (symbol? binding) 336 | (list (assoc ctx binding value)) 337 | (vector? binding) 338 | (cond 339 | (every? symbol? binding) 340 | (cond 341 | ;; collection binding 342 | (-> binding second (= '...)) 343 | (map #(assoc ctx (first binding) %) value) 344 | ;; tuple binding 345 | :else 346 | (->> (interleave binding value) 347 | (apply assoc ctx) 348 | list)) 349 | ;; relation binding 350 | (-> binding first vector?) 351 | (map #(apply assoc ctx 352 | (interleave (first binding) %)) 353 | value)))) 354 | 355 | 356 | (defn eval-expression-clause 357 | "Evaluate an expression fn `expr-f` according to `ctx`. 358 | 359 | If `binding` is nil then the original clause was just 360 | a predicate clause, so if the result is logical true, 361 | then a singleton list of the same context is returned. 362 | Otherwise it was a function clause and the result is 363 | bound to produce a non-empty list of new contexts." 364 | [ctx expr-f binding] 365 | (if binding 366 | (->> ctx expr-f (bind-binding ctx binding)) 367 | (when (expr-f ctx) 368 | (list ctx)))) 369 | 370 | 371 | ;; assume ctx has % for the rule set 372 | (defn resolve-rule-invoc 373 | "Resolves a rule invocation `rule-invoc` according to `ctx`. 374 | This function returns a sequence of triples. 375 | 376 | The first element of a triple is the input context, 377 | the context that the rule-body should be evaluated under. 378 | This includes the database, bound to `$`, the rule set, 379 | bound to `%`, and any input parameters that were bound 380 | at invocation. 381 | 382 | The second element of a triple is the output context. 383 | This is a mapping from parameters of the rule head that 384 | where unbound at invocation, mapped to argument variables. 385 | The evaluation of the rule body will bind values to the 386 | parameter variables, which can then be lifted to values 387 | for the argument variables in the invocation (outer) 388 | context. 389 | 390 | The third element of a triple is the rule body. 391 | 392 | For example, 393 | ctx 394 | {'$ ... 395 | '% '[[(my-rule ?i ?o) 396 | [...] 397 | [...]]] 398 | '?my-in-var 10} 399 | rule-invoc 400 | '(my-rule ?my-in-var ?my-out-var) 401 | gives 402 | in-ctx 403 | {'$ ... 404 | '% '[[(my-rule ?i ?o) 405 | [...] 406 | [...]]] 407 | '?i 10} 408 | out-ctx 409 | '{?o ?my-out-var} 410 | rule-body 411 | [[...] [...]] 412 | " 413 | [ctx rule-invoc] 414 | (let [rules (get ctx '%) ;; lookup rules from context 415 | [db rule-name & rule-args] 416 | (if (-> rule-invoc first name first (= \$)) 417 | ;; if first element is db var, look it up 418 | (cons (get ctx 419 | (first rule-invoc)) 420 | (rest rule-invoc)) 421 | ;; otherwise use the default db var 422 | (cons (get ctx '$) 423 | rule-invoc)) 424 | rule-defs 425 | (filter #(= rule-name (ffirst %)) rules)] 426 | (if rule-defs ;; check that some rule defs are actually found 427 | (for [[[_ & rule-params] & rule-body] rule-defs] 428 | (conj 429 | (reduce-kv ;; build the input and output contexts 430 | (fn [[in-ctx out-ctx] param arg] 431 | (if-let [x (get ctx arg)] 432 | [(assoc in-ctx param x) out-ctx] 433 | [in-ctx (assoc out-ctx param arg)])) 434 | [{'$ db '% rules} ;; the input context starts with a db and rules 435 | {}] 436 | (zipmap rule-params rule-args)) 437 | rule-body)) 438 | (throw (IllegalArgumentException. (str "No rule definition found for " 439 | rule-name)))))) 440 | 441 | 442 | (defn trace-iterator 443 | "Trace an iterator: `cnt-fn!` should be 444 | a 0-arity function that will be invoked 445 | once for each next on the underlying 446 | iterator." 447 | [^Iterable iterable cnt-fn!] 448 | (let [iter (.iterator iterable)] 449 | (reify java.util.Iterator 450 | (hasNext [_] 451 | (.hasNext iter)) 452 | (next [_] 453 | (cnt-fn!) 454 | (.next iter)) 455 | (remove [_] 456 | (throw (UnsupportedOperationException.)))))) 457 | 458 | 459 | ;; declare to enable mutual recursion 460 | (declare eval-rule-invoc) 461 | 462 | (defn eval-one-clause 463 | "Evaluate a single `clause` according to `ctx`. 464 | 465 | Returns a lazy sequence of extended eval contexts. 466 | The counter map `cnt-map` is used to trace the datoms 467 | that are consumed (and which index they were consumed 468 | from). Only when the lazy sequence is forced will 469 | the counter map hold the true total. 470 | 471 | If the clause is a rule invocation, then the rule evaluation 472 | recurses." 473 | [ctx cnt-map [clause-type & clause]] 474 | (case clause-type 475 | :expr 476 | (apply eval-expression-clause ctx clause) 477 | :rule 478 | (eval-rule-invoc ctx cnt-map clause) 479 | :data 480 | (let [[db clause1] 481 | (lookup-db-for-clause ctx clause) 482 | [index components filter-fn] 483 | (compute-index-traversal (partial is-ref-attr? db) 484 | (partial has-index? db) 485 | ctx 486 | clause1) 487 | cnt-fn! (fn [] 488 | (swap! cnt-map 489 | #(update-in % [index] 490 | (fnil inc 0)))) 491 | datoms (-> 492 | (apply d/datoms db index components) 493 | (trace-iterator cnt-fn!) 494 | iterator-seq)] 495 | (bind-datoms ctx 496 | clause 497 | (if filter-fn 498 | (filter filter-fn datoms) 499 | datoms))))) 500 | 501 | 502 | (defn eval-rule-invoc 503 | "Evaluate a rule invocation `rule-invoc` according to `ctx`. 504 | 505 | This produces a lazy sequence of all extended contexts 506 | produced, by evaluating all rule heads that match, potentially 507 | with recursion." 508 | [ctx cnt-map rule-invoc] 509 | (mapcat ;; mapcat over all rule invocation resolutions 510 | (fn [[in-ctx out-ctx rule-body]] 511 | (let [;; a fn to recursively evaluate the rule body 512 | go (fn rec [curr-ctx body-clauses] 513 | (if (seq body-clauses) 514 | ;; if there more clauses 515 | (->> (first body-clauses) 516 | ;; evalute the first to a sequence of contexts 517 | (eval-one-clause curr-ctx cnt-map) 518 | ;; and recursively eval the rest of the body 519 | ;; for each of those contexts 520 | (mapcat #(rec % (rest body-clauses)))) 521 | ;; else return the context as is 522 | (list curr-ctx)))] 523 | (->> 524 | ;; prepare the rule body by abstract all the clauses 525 | (abstract-clauses in-ctx rule-body) 526 | ;; recursively eval 527 | (apply go) 528 | ;; extract the output variables into the original context 529 | (map 530 | (fn [rule-ctx] 531 | (into ctx ;; augment original ctx 532 | (reduce-kv ;; with rule-ctx according to out-ctx 533 | (fn [acc param arg] 534 | (assoc acc arg (get rule-ctx param))) 535 | {} 536 | out-ctx))))))) 537 | (resolve-rule-invoc ctx rule-invoc))) 538 | 539 | 540 | (defn count-datom-usage 541 | "Count the number of datoms accessed while evaluating 542 | `clauses` according to evaluation contexts `ctxs`. 543 | 544 | This returns a sequence of the clauses paired with the 545 | index that was used for evaluating the clause as well 546 | as the number of datoms retrieved from that index." 547 | [ctxs clauses] 548 | (let [cnts (-> clauses count (repeat {}) vec atom) 549 | go (fn rec [i ctx clauses] 550 | (when (seq clauses) 551 | (let [cnt-map (atom {})] 552 | ;; force the evaluation of the ctxs for the first 553 | ;; clause, recursing into the rest 554 | (doseq [ctx1 (eval-one-clause ctx cnt-map (first clauses))] 555 | (rec (inc i) ctx1 (rest clauses))) 556 | ;; all datoms needed for the first will now have been 557 | ;; consumed, so `cnt-map` holds the totals 558 | (swap! cnts 559 | #(assoc % i 560 | (merge-with + 561 | @cnt-map 562 | (nth % i)))))))] 563 | (doseq [ctx ctxs] 564 | (apply go 0 (abstract-clauses ctx clauses))) 565 | (map vector clauses @cnts))) 566 | 567 | 568 | (defn extract-query 569 | "Given a regular Datomic query, extract the `:in` and 570 | `:where` sections. 571 | 572 | Returns a pair of the `:in` params and the 573 | `:where` clauses. 574 | 575 | Note that this function will accept the query in 576 | either vector or map form." 577 | [query] 578 | (cond 579 | (vector? query) 580 | (let [q1 (if (some #{:in} query) 581 | (drop-while #(not= % :in) query) 582 | (into '[:in $] 583 | (drop-while #(not= % :where) query))) 584 | [in-vars where-and-clauses] (split-with #(not= % :where) (rest q1))] 585 | [(or (seq in-vars) 586 | '($)) 587 | (rest where-and-clauses)]) 588 | (map? query) 589 | [(or (seq (:in query)) 590 | '($)) 591 | (:where query)])) 592 | 593 | 594 | (defn q-explain 595 | "Explain a Datomic query by showing the indexes that 596 | were accessed and the number of datoms consumed. 597 | 598 | This function will receive the same arguments as 599 | Datomic's `q` function, but will return the query 600 | explanation rather than the result set." 601 | [query & args] 602 | (let [[in-vars clauses] (extract-query query)] 603 | (when (not= (count args) (count in-vars)) 604 | ;; complain if param and arg arity don't align 605 | (throw (IllegalArgumentException. (str "query expected " 606 | (count in-vars) 607 | " arguments, but given " 608 | (count args))))) 609 | (let [go (fn rec [curr-ctx bindings args] 610 | (if (seq bindings) 611 | (->> [(first bindings) (first args)] 612 | (apply bind-binding curr-ctx) 613 | (mapcat #(rec % (rest bindings) (rest args)))) 614 | (list curr-ctx)))] 615 | (count-datom-usage (go {} in-vars args) 616 | clauses)))) 617 | -------------------------------------------------------------------------------- /test/datomic_q_explain/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-q-explain.core-test 2 | (:require [clojure.test :refer :all] 3 | [datomic-q-explain.core :refer :all] 4 | [datomic.api :as d])) 5 | 6 | 7 | (deftest attribute-predicate-tests 8 | (let [uri "datomic:mem://attribute-predicate-tests"] 9 | (d/create-database uri) 10 | (try 11 | (let [conn (d/connect uri) 12 | db (d/db conn)] 13 | 14 | (testing "is-ref-attr?" 15 | (is (= true 16 | (is-ref-attr? db :db.install/attribute))) 17 | (is (= false 18 | (is-ref-attr? db :db/doc)))) 19 | 20 | (testing "has-index?" 21 | (is (= true 22 | (boolean (has-index? db :db/ident)))) 23 | (is (= false 24 | (boolean (has-index? db :db/doc)))))) 25 | (finally 26 | (d/delete-database uri))))) 27 | 28 | 29 | (deftest bind-datoms-test 30 | (testing "bind :e :a :v and :tx" 31 | (let [res 32 | (bind-datoms {} 33 | '[?e ?a ?v ?tx] 34 | [{:e 1 :a 0 :v "a" :tx 123 :added true}])] 35 | (is (= 1 (count res))) 36 | (let [ctx (first res)] 37 | (is (= 1 38 | (get ctx '?e))) 39 | (is (= 0 40 | (get ctx '?a))) 41 | (is (= "a" 42 | (get ctx '?v))) 43 | (is (= 123 44 | (get ctx '?tx)))))) 45 | 46 | (testing "don't bind blank" 47 | (let [res 48 | (bind-datoms {} 49 | '[?e ?a _ ?tx] 50 | [{:e 1 :a 0 :v "a" :tx 123 :added true}])] 51 | (is (= 1 (count res))) 52 | (let [ctx (first res)] 53 | (is (= 3 54 | (count ctx))) 55 | (is (= 1 56 | (get ctx '?e))) 57 | (is (= 0 58 | (get ctx '?a))) 59 | (is (= 123 60 | (get ctx '?tx)))))) 61 | 62 | (testing "skip already bound vars" 63 | (let [res 64 | (bind-datoms '{?v "b"} 65 | '[?e ?a ?v ?tx] 66 | [{:e 1 :a 0 :v "a" :tx 123 :added true}])] 67 | (is (= 1 (count res))) 68 | (let [ctx (first res)] 69 | (is (= 1 70 | (get ctx '?e))) 71 | (is (= 0 72 | (get ctx '?a))) 73 | (is (= "b" 74 | (get ctx '?v))) 75 | (is (= 123 76 | (get ctx '?tx)))))) 77 | 78 | (testing "bind many datoms" 79 | (let [res 80 | (bind-datoms '{?e 10} 81 | '[?e ?a] 82 | [{:e 1 :a 0 :v "a" :tx 123 :added true} 83 | {:e 1 :a 1 :v "a" :tx 123 :added true} 84 | {:e 1 :a 2 :v "a" :tx 123 :added true} 85 | {:e 1 :a 3 :v "a" :tx 123 :added true}])] 86 | (is (= 4 (count res))) 87 | (is (= '{?e 10 ?a 0} 88 | (nth res 0))) 89 | (is (= '{?e 10 ?a 1} 90 | (nth res 1))) 91 | (is (= '{?e 10 ?a 2} 92 | (nth res 2))) 93 | (is (= '{?e 10 ?a 3} 94 | (nth res 3)))))) 95 | 96 | 97 | (deftest abstract-clause-test 98 | (testing "abstract nothing when all vars" 99 | (let [ctx {} 100 | clause '[?e ?a ?v] 101 | [ctx1 [lbl & clause1]] (abstract-clause ctx clause)] 102 | (is (= ctx ctx1)) 103 | (is (= :data lbl)) 104 | (is (= clause clause1)))) 105 | 106 | (testing "don't abstract db vars" 107 | (let [ctx {} 108 | clause '[$ ?e ?a] 109 | [ctx1 [lbl & clause1]] (abstract-clause ctx clause)] 110 | (is (= ctx ctx1)) 111 | (is (= :data lbl)) 112 | (is (= clause clause1))) 113 | (let [ctx {} 114 | clause '[$db ?e ?a] 115 | [ctx1 [lbl & clause1]] (abstract-clause ctx clause)] 116 | (is (= ctx ctx1)) 117 | (is (= :data lbl)) 118 | (is (= clause clause1)))) 119 | 120 | (testing "skip wildcard" 121 | (let [ctx {} 122 | clause '[?e _ ?v] 123 | [ctx1 [lbl & clause1]] (abstract-clause ctx clause)] 124 | (is (= ctx ctx1)) 125 | (is (= :data lbl)) 126 | (is (= clause clause1)))) 127 | 128 | (testing "abstract attribute" 129 | (let [ctx {} 130 | clause '[?e :attr ?v] 131 | [ctx1 [lbl & clause1]] (abstract-clause ctx clause)] 132 | (is (= :data lbl)) 133 | (is (= 1 134 | (count ctx1))) 135 | (is (some #{:attr} 136 | (vals ctx1))) 137 | (is (= :attr 138 | (get ctx1 139 | (nth clause1 1))))))) 140 | -------------------------------------------------------------------------------- /test/datomic_q_explain/test_select_index.clj: -------------------------------------------------------------------------------- 1 | (ns datomic-q-explain.test-select-index 2 | (:require [clojure.test :refer :all] 3 | [datomic-q-explain.core :refer :all] 4 | [datomic.api :as d])) 5 | 6 | 7 | (defn eval-where-clause 8 | "Evaluate a single where clause" 9 | [datoms-fn is-ref-attr? has-index? ctx clause] 10 | (let [[index components filter-fn] (compute-index-traversal is-ref-attr? has-index? ctx clause) 11 | ds (seq (apply datoms-fn index components))] 12 | (if filter-fn 13 | (filter filter-fn ds) 14 | ds))) 15 | 16 | 17 | (deftest where-clause-eavt 18 | (let [test-datom-a {:e 1000 :a 10 :v "a" :tx 101 :added true} 19 | test-datom-b {:e 1000 :a 11 :v "b" :tx 101 :added true} 20 | test-datom-c {:e 1000 :a 11 :v "c" :tx 102 :added true} 21 | test-datoms [test-datom-a test-datom-b test-datom-c] 22 | 23 | is-ref-attr? (fn [_] false) 24 | has-index? (fn [_] false)] 25 | 26 | (testing "queries requiring the :eavt index" 27 | (let [test-datoms-fn-scan-e 28 | (fn [index e] 29 | (is (= :eavt index)) 30 | (is (= 1000 e)) 31 | test-datoms)] 32 | 33 | (testing "scanning the entity" 34 | (let [res 35 | (eval-where-clause test-datoms-fn-scan-e 36 | is-ref-attr? 37 | has-index? 38 | '{?e 1000} 39 | '[?e ?a ?v])] 40 | (is (= 3 41 | (count res))) 42 | (is (some #{test-datom-a} res)) 43 | (is (some #{test-datom-b} res)) 44 | (is (some #{test-datom-c} res)))) 45 | 46 | (testing "scaning the entity and filtering by value" 47 | (let [res 48 | (eval-where-clause test-datoms-fn-scan-e 49 | is-ref-attr? 50 | has-index? 51 | '{?e 1000 ?v "a"} 52 | '[?e ?a ?v])] 53 | (is (= 1 54 | (count res))) 55 | (is (= test-datom-a 56 | (first res)))) 57 | 58 | (let [res 59 | (eval-where-clause test-datoms-fn-scan-e 60 | is-ref-attr? 61 | has-index? 62 | '{?e 1000 ?v "d"} 63 | '[?e ?a ?v])] 64 | (is (empty? res)))) 65 | 66 | (testing "scaning the entity and filtering by tx" 67 | (let [res 68 | (eval-where-clause test-datoms-fn-scan-e 69 | is-ref-attr? 70 | has-index? 71 | '{?e 1000 ?t 101} 72 | '[?e ?a ?v ?t])] 73 | (is (= 2 74 | (count res))) 75 | (is (some #{test-datom-a} res)) 76 | (is (some #{test-datom-b} res)))))))) 77 | 78 | 79 | (deftest where-clause-aevt 80 | (let [test-datom-a {:e 1000 :a 10 :v "a" :tx 101 :added true} 81 | test-datom-b {:e 1001 :a 10 :v "b" :tx 101 :added true} 82 | test-datom-c {:e 1001 :a 10 :v "a" :tx 102 :added true} 83 | test-datoms [test-datom-a test-datom-b test-datom-c] 84 | 85 | is-ref-attr? (fn [_] false) 86 | has-index? (fn [_] false)] 87 | 88 | (testing "queries requiring the :aevt index" 89 | (let [test-datoms-fn-scan-a 90 | (fn [index a] 91 | (is (= :aevt index)) 92 | (is (= 10 a)) 93 | test-datoms)] 94 | 95 | (testing "scanning the attribute" 96 | (let [res 97 | (eval-where-clause test-datoms-fn-scan-a 98 | is-ref-attr? 99 | has-index? 100 | '{?a 10} 101 | '[?e ?a ?v])] 102 | (is (= 3 103 | (count res))) 104 | (is (some #{test-datom-a} res)) 105 | (is (some #{test-datom-b} res)) 106 | (is (some #{test-datom-c} res)))) 107 | 108 | (testing "scaning the attribute and filtering by value" 109 | (let [res 110 | (eval-where-clause test-datoms-fn-scan-a 111 | is-ref-attr? 112 | has-index? 113 | '{?a 10 ?v "a"} 114 | '[?e ?a ?v])] 115 | (is (= 2 116 | (count res))) 117 | (is (some #{test-datom-a} res)) 118 | (is (some #{test-datom-c} res))) 119 | 120 | (is (empty? (eval-where-clause test-datoms-fn-scan-a 121 | is-ref-attr? 122 | has-index? 123 | '{?a 10 ?v "d"} 124 | '[?e ?a ?v])))) 125 | 126 | (testing "scaning the attribute and filtering by tx" 127 | (let [res 128 | (eval-where-clause test-datoms-fn-scan-a 129 | is-ref-attr? 130 | has-index? 131 | '{?a 10 ?t 101} 132 | '[?e ?a ?v ?t])] 133 | (is (= 2 134 | (count res))) 135 | (is (some #{test-datom-a} res)) 136 | (is (some #{test-datom-b} res)))) 137 | 138 | (testing "scanning the attribute and filter by both value and tx" 139 | (let [res 140 | (eval-where-clause test-datoms-fn-scan-a 141 | is-ref-attr? 142 | has-index? 143 | '{?a 10 ?v "a" ?t 102} 144 | '[?e ?a ?v ?t])] 145 | (is (= 1 146 | (count res))) 147 | (is (= test-datom-c 148 | (first res))))))))) 149 | 150 | 151 | (deftest where-clause-vaet 152 | (let [test-datom-a {:e 1000 :a 10 :v 1003 :tx 101 :added true} 153 | test-datom-b {:e 1001 :a 10 :v 1003 :tx 102 :added true} 154 | test-datoms [test-datom-a test-datom-b] 155 | 156 | is-ref-attr? (fn [_] true) 157 | has-index? (fn [_] false)] 158 | 159 | (testing "queries requiring the :vaet index" 160 | (let [test-datoms-fn 161 | (fn [index v a] 162 | (is (= :vaet index)) 163 | (is (= 1003 v)) 164 | (is (= 10 a)) 165 | test-datoms)] 166 | 167 | (testing "lookup by attribute and value" 168 | (let [res 169 | (eval-where-clause test-datoms-fn 170 | is-ref-attr? 171 | has-index? 172 | '{?a 10 ?v 1003} 173 | '[?e ?a ?v])] 174 | (is (= 2 175 | (count res))) 176 | (is (some #{test-datom-a} res)) 177 | (is (some #{test-datom-b} res)))) 178 | 179 | (testing "lookup by attribute and value, filtering by t" 180 | (let [res 181 | (eval-where-clause test-datoms-fn 182 | is-ref-attr? 183 | has-index? 184 | '{?a 10 ?v 1003 ?t 101} 185 | '[?e ?a ?v ?t])] 186 | (is (= 1 187 | (count res))) 188 | (is (some #{test-datom-a} res))))) 189 | 190 | (let [test-datoms-fn 191 | (fn [index v] 192 | (is (= :vaet index)) 193 | (is (= 1003 v)) 194 | test-datoms)] 195 | 196 | (testing "lookup by value" 197 | (let [res 198 | (eval-where-clause test-datoms-fn 199 | is-ref-attr? 200 | has-index? 201 | '{?v 1003} 202 | '[?e ?a ?v])] 203 | (is (= 2 204 | (count res))) 205 | (is (some #{test-datom-a} res)) 206 | (is (some #{test-datom-b} res)))) 207 | 208 | (testing "lookup by value, filtering by t" 209 | (let [res 210 | (eval-where-clause test-datoms-fn 211 | is-ref-attr? 212 | has-index? 213 | '{?v 1003 ?t 101} 214 | '[?e ?a ?v ?t])] 215 | (is (= 1 216 | (count res))) 217 | (is (some #{test-datom-a} res)))))))) 218 | 219 | (deftest where-clause-avet 220 | (let [test-datom-a {:e 1000 :a 10 :v "a" :tx 101 :added true} 221 | test-datom-b {:e 1001 :a 10 :v "a" :tx 102 :added true} 222 | test-datom-c {:e 1002 :a 10 :v "b" :tx 103 :added true} 223 | 224 | is-ref-attr? (fn [_] false) 225 | has-index? (fn [_] true)] 226 | 227 | (testing "lookups requiring the :avet index" 228 | (let [test-datoms-fn 229 | (fn [index a v] 230 | (is (= :avet index)) 231 | (is (= 10 a)) 232 | (is (= "a" v)) 233 | [test-datom-a test-datom-b])] 234 | 235 | (testing "lookup by attribute and value" 236 | (let [res 237 | (eval-where-clause test-datoms-fn 238 | is-ref-attr? 239 | has-index? 240 | '{?a 10 ?v "a"} 241 | '[?e ?a ?v])] 242 | (is (= 2 243 | (count res))) 244 | (is (some #{test-datom-a} res)) 245 | (is (some #{test-datom-b} res)))) 246 | 247 | (testing "lookup by attribute and value, filtering by t" 248 | (let [res 249 | (eval-where-clause test-datoms-fn 250 | is-ref-attr? 251 | has-index? 252 | '{?a 10 ?v "a" ?t 101} 253 | '[?e ?a ?v ?t])] 254 | (is (= 1 255 | (count res))) 256 | (is (some #{test-datom-a} res)))))))) 257 | 258 | 259 | 260 | 261 | (deftest where-clause-with-blank-value 262 | (let [test-datom-a {:e 1 :a 0 :v "a" :tx 123 :added true} 263 | test-datom-b {:e 1 :a 0 :v "b" :tx 124 :added true} 264 | test-datoms [test-datom-a test-datom-b] 265 | 266 | is-ref-attr? (fn [_] false) 267 | has-index? (fn [_] false)] 268 | 269 | (testing ":where clause (size 2) evaluation" 270 | 271 | (testing "with empty context" 272 | (let [test-datoms-fn 273 | (fn [& _] 274 | (throw (Exception. "should not have been invoked")))] 275 | (is (thrown? IllegalArgumentException 276 | (eval-where-clause test-datoms-fn 277 | is-ref-attr? 278 | has-index? 279 | {} 280 | '[?e ?a]))))) 281 | 282 | (testing "with entity position bound" 283 | (let [test-datoms-fn 284 | (fn [index e] 285 | (is (= :eavt index)) 286 | (is (= 1 e)) 287 | test-datoms) 288 | res 289 | (eval-where-clause test-datoms-fn 290 | is-ref-attr? 291 | has-index? 292 | '{?e 1} 293 | '[?e ?a])] 294 | (is (= 2 295 | (count res))) 296 | (is (some #{test-datom-a} res)) 297 | (is (some #{test-datom-b} res))) 298 | 299 | (let [test-datoms-fn 300 | (fn [index e] 301 | (is (= :eavt index)) 302 | (is (= 1 e)) 303 | '())] 304 | (is (empty? (eval-where-clause test-datoms-fn 305 | is-ref-attr? 306 | has-index? 307 | '{?e 1} 308 | '[?e ?a]))))) 309 | 310 | (testing "with attribute position bound" 311 | (let [test-datoms-fn 312 | (fn [index a] 313 | (is (= :aevt index)) 314 | (is (= 0 a)) 315 | test-datoms) 316 | res 317 | (eval-where-clause test-datoms-fn 318 | is-ref-attr? 319 | has-index? 320 | '{?a 0} 321 | '[?e ?a])] 322 | (is (= 2 323 | (count res))) 324 | (is (some #{test-datom-a} res)) 325 | (is (some #{test-datom-b} res))) 326 | 327 | (let [test-datoms-fn 328 | (fn [index a] 329 | (is (= :aevt index)) 330 | (is (= 0 a)) 331 | '())] 332 | (is (empty? (eval-where-clause test-datoms-fn 333 | is-ref-attr? 334 | has-index? 335 | '{?a 0} 336 | '[?e ?a]))))) 337 | 338 | (testing "with entity and attribute positions bound" 339 | (let [test-datoms-fn 340 | (fn [index e a] 341 | (is (= :eavt index)) 342 | (is (= 1 e)) 343 | (is (= 0 a)) 344 | test-datoms) 345 | res 346 | (eval-where-clause test-datoms-fn 347 | is-ref-attr? 348 | has-index? 349 | '{?e 1 ?a 0} 350 | '[?e ?a])] 351 | (is (= 2 352 | (count res))) 353 | (is (some #{test-datom-a} res)) 354 | (is (some #{test-datom-b} res))) 355 | 356 | (let [test-datoms-fn 357 | (fn [index e a] 358 | (is (= :eavt index)) 359 | (is (= 1 e)) 360 | (is (= 0 a)) 361 | '())] 362 | (is (empty? (eval-where-clause test-datoms-fn 363 | is-ref-attr? 364 | has-index? 365 | '{?e 1 ?a 0} 366 | '[?e ?a])))))))) 367 | --------------------------------------------------------------------------------