├── .circleci └── config.yml ├── .gitignore ├── LICENSE ├── README.md ├── project.clj ├── src └── spark │ ├── spec_tacular.clj │ └── spec_tacular │ ├── datomic.clj │ ├── datomic │ ├── coerce.clj │ ├── deprecated.clj │ ├── pull_helpers.clj │ ├── query_helpers.clj │ └── util.clj │ ├── generators.clj │ ├── grammar.clj │ ├── restify.clj │ ├── schema.clj │ └── spec.clj └── test └── spark ├── spec_tacular ├── datomic │ ├── pull_helpers_test.clj │ ├── pull_test.clj │ ├── query_helpers_test.clj │ └── query_test.clj ├── datomic_test.clj ├── grammar_test.clj ├── meta_test.clj ├── readme_test.clj ├── schema_test.clj ├── test_specs.clj ├── test_utils.clj └── typecheck_test.clj └── spec_tacular_test.clj /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | jobs: 3 | build: 4 | docker: 5 | - image: circleci/clojure:lein-2.7.1 6 | steps: 7 | - checkout 8 | 9 | #Install & cache dependencies 10 | - restore_cache: 11 | key: sparkfund--{{ .Environment.CIRCLE_PROJECT_REPONAME }}--maven-deps--{{ checksum "project.clj" }} 12 | key: sparkfund--{{ .Environment.CIRCLE_PROJECT_REPONAME }}--maven-deps 13 | - run: 14 | name: List Machine Info 15 | command: java -version; echo; lein --version 16 | - run: 17 | name: Install Dependencies 18 | command: lein deps 19 | - save_cache: 20 | key: sparkfund--{{ .Environment.CIRCLE_PROJECT_REPONAME }}--maven-deps--{{ checksum "project.clj" }} 21 | paths: 22 | - "~/.m2" 23 | 24 | - run: 25 | name: Run Type Checks 26 | command: lein typed check 27 | - run: 28 | name: Run Tests 29 | command: lein test 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | *.iml 11 | /doc 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # spec-tacular 2 | 3 | Write spectacular data definitions! Our goal is to make the border 4 | between Clojure and Datomic a more convenient and safe place to live. 5 | [Browse the API](http://sparkfund.github.io/spec-tacular) or continue 6 | scrolling. 7 | 8 | Define your Datomic schemas using spec-tacular's spec DSL and receive 9 | the following in return: 10 | 11 | * **Representation of Datomic entities as maps** that verify (upon 12 | creation and association) that entity attributes have the correct 13 | fields, and in turn, the correct types 14 | 15 | * **Core Typed aliases for each spec** 16 | 17 | * **Specialized query language** with a map-like syntax that allows 18 | queries to be expressed with domain-specific spec keywords instead 19 | of Datomic attribute-keywords. Entities returned from queries are 20 | lazily constructed and can be used in typed code without extra 21 | casts. 22 | 23 | * **Simple transaction interface with Datomic**, using `create!` as a 24 | constructor, and `assoc!` as an update function. 25 | 26 | ***WARNING:*** spec-tacular is not maintained. 27 | 28 | ## Quick Start 29 | 30 | ```clojure 31 | [spec-tacular "0.6.2-SNAPSHOT"] ; unstable 32 | [spec-tacular "0.6.1"] 33 | ``` 34 | 35 | ```xml 36 | 37 | spec-tacular 38 | spec-tacular 39 | 0.6.1 40 | 41 | ``` 42 | 43 | ## Usage 44 | 45 | ### Creating Specs 46 | 47 | ```clojure 48 | (require '[spark.spec-tacular :as sp :refer [defspec defunion defenum]]) 49 | ``` 50 | 51 | ```clojure 52 | 53 | ;; Sets up a House entity containing a mandantory color and optionally 54 | ;; a Mailbox. It may also link in any number of Occupants. 55 | (defspec House 56 | (:link [occupants :is-many :Occupant]) 57 | [mailbox :is-a :Mailbox] 58 | [color :is-a :Color :required]) 59 | 60 | (defenum Color ;; Houses can only be green or orange.. 61 | green, orange) ;; makes for interesting neighborhoods 62 | 63 | (defspec Mailbox ;; Hope you don't want to get your mail 64 | [has-mail? :is-a :boolean]) ;; cause mailboxes only know if they have mail 65 | 66 | ;; Specs can have docstrings 67 | (defspec Chimney 68 | "Chimneys are super complicated and require documentation" 69 | (:link [house :is-a House])) 70 | (doc Chimney) ;; Such words 71 | 72 | ;; Houses can be occupied by either People or Pets. 73 | (defunion Occupant :Person :Pet) 74 | 75 | ;; Each Person has a name that serves as an identifying field 76 | ;; (implemented as Datomic's notion of identity), and an age. 77 | (defspec Person 78 | [name :is-a :string :identity :unique] 79 | [age :is-a :long]) 80 | 81 | (defunion Pet :Dog :Cat :Porcupine) 82 | 83 | (defspec Dog 84 | [fleas? :is-a :boolean]) 85 | 86 | ;; Cats can contain links (passed by reference to the database) to all 87 | ;; the occupants of the house that they hate. For their nefarious 88 | ;; plots, no doubt. 89 | (defspec Cat 90 | [hates :is-many :Occupant :link]) 91 | 92 | (defspec Porcupine) ;; No fields, porcupines are boring 93 | ``` 94 | 95 | ### Creating Databases 96 | ```clojure 97 | (require '[spark.spec-tacular.schema :as schema]) 98 | ``` 99 | 100 | ```clojure 101 | ;; Returns a schema with entries for each spec defined in my-ns 102 | (schema/from-namespace *ns*) 103 | ;; => ({:db/id ...., 104 | ;; :db/ident :house/occupants, 105 | ;; :db/valueType :db.type/ref, 106 | ;; :db/cardinality :db.cardinality/many, 107 | ;; ....} 108 | ;; ....) 109 | 110 | ;; Creates a database with the earlier schema installed. 111 | ;; Returns a connection to that database. 112 | (schema/to-database! (schema/from-namespace *ns*)) 113 | ;; => # 114 | ``` 115 | 116 | ### Changing Databases 117 | ```clojure 118 | (require '[spark.spec-tacular.datomic :as sd]) 119 | ``` 120 | 121 | ```clojure 122 | ;; Use the House schema to create a database and connection 123 | (def conn-ctx {:conn (schema/to-database! (schema/from-namespace *ns*))}) 124 | 125 | ;; Create a green house: 126 | (def h (sd/create! conn-ctx (house {:color :Color/green}))) 127 | 128 | ;; Some quick semantics: 129 | (:color h) ;; => :Color/green 130 | (= h (house {:color :Color/green})) ;; => false 131 | (sp/refless= h (house {:color :Color/green})) ;; => true 132 | (assoc h :random-kw 42) ;; => error 133 | (set [h h]) ;; => #{h} 134 | (set [h (house {:color :Color/green})]) ;; => #{h (house {:color :Color/green})} 135 | 136 | ;; Let some people move in: 137 | (def joe (sd/create! conn-ctx (person {:name "Joe" :age 32}))) 138 | (def bernard (sd/create! conn-ctx (person {:name "Bernard" :age 25}))) 139 | 140 | (def new-h (sd/assoc! conn-ctx h :occupants [joe bernard])) 141 | ;; => assoc! returns a new House with the new field 142 | 143 | h ;; => is still the simple green house 144 | (sd/refresh conn-ctx h) ;; => new-h 145 | ;; In most cases, you can forego the `refresh` and just use the return 146 | ;; value of `assoc!` 147 | 148 | ;; Bernard and Joe get a cat, who hates both of them, 149 | (def zuzu (sd/create! conn-ctx (cat {:hates (:occupants new-h)}))) 150 | (sd/assoc! conn-ctx h :occupants (conj (:occupants new-h) zuzu)) 151 | 152 | ;; They build a mailbox, and try to put it up in another House: 153 | (let [mb (mailbox {:has-mail? false}) 154 | h1 (sd/assoc! conn-ctx h :mailbox mb) 155 | h2 (sd/create! conn-ctx (house {:color :Color/orange :mailbox mb}))] 156 | ;; But since Mailboxes are passed by value, 157 | ;; the Mailbox get duplicated 158 | (= (:mailbox h1) (:mailbox h2)) ;; => false 159 | ....) 160 | ```` 161 | 162 | ### Querying Databases 163 | ```clojure 164 | (require '[spark.spec-tacular.datomic :as sd]) 165 | ``` 166 | 167 | ```clojure 168 | 169 | ;; First let's distinguish the mailboxes -- let's say Joe and Bernard 170 | ;; get some mail 171 | (def mb1 (sd/assoc! conn-ctx (:mailbox h1) :has-mail? true)) 172 | 173 | ;; Get the database 174 | (def db (sd/db conn-ctx)) 175 | 176 | ;; Use % to look for the only find variable 177 | (sd/q :find [:Mailbox ...] :in db :where [% {:has-mail? false}]) 178 | ;; => #{(:mailbox h2)}, the mailbox from house h2 179 | (sd/q :find [:Mailbox ...] :in db :where [% {:has-mail? true}]) 180 | ;; => #{mb1}, that's Joe and Bernard's mailbox 181 | 182 | ;; Find the Houses without mail 183 | (sd/q :find [:House ...] :in db :where 184 | [% {:mailbox {:has-mail false}}]) 185 | ;; => #{h2} 186 | 187 | ;; Find the House and it's human occupants when the mailbox has mail 188 | ;; Use %1 and %2 to to look for multiple find variables 189 | (sd/q :find :House :Person :in db :where 190 | [%1 {:occupants %2 :mailbox {:has-mail true}}]) 191 | ;; => #{[h1 joe] [h2 bernard]} 192 | ``` 193 | 194 | This last example means we're looking for any `:occupants` that are 195 | `:Person`s. Even though we represent Datomic's cardinality "many" as 196 | a collection in Clojure, we still use a relation to search for members 197 | of that collection on the database. Those familiar with Datomic may 198 | understand that this part of the query (roughly) expands to 199 | 200 | ```clojure 201 | [.... [?house :house/occupants ?person] ....] 202 | ``` 203 | 204 | When we get the result of the query back in Clojure, we take that 205 | result and return it as a set. Onwards! 206 | 207 | ```clojure 208 | 209 | ;; If you want to get the spec name of entities on the database, you 210 | ;; can use the special :spec-tacular/spec keyword. Here we restrict 211 | ;; the occupants to the :Pet spec and then return all kinds of Pet's 212 | ;; that live in houses: 213 | (sd/q :find [:string ...] :in db :where 214 | [:House {:occupants [:Person {:name %}]}]) 215 | ;; => #{"Joe" "Bernard"} 216 | 217 | ``` 218 | 219 | Although maps work as you would expect in a query, the vector form 220 | `[ ]` is protected syntax meaning the `map` should be 221 | restricted to things of type ``. 222 | 223 | ## Updating from v.0.4.x to v0.5.0 224 | 225 | * Replace all `spark.sparkspec` namespaces with `spark.spec-tacular` 226 | * Check all calls to `=` to see if `refless=` is more appropriate 227 | * Check all `set`s if you mix local instances and instances on the 228 | database; these are nolonger `=` nor do they hash to the same number 229 | even if they are otherwise equivalent. 230 | * Rename `defenum` to `defunion` 231 | 232 | ## Updating from v.0.5.x to v0.6.0 233 | 234 | * `:is-many` fields are now represented as 235 | `clojure.lang.PersistentHashSet`s 236 | * `spark.spec-tacular.restify` was removed, it may come back 237 | eventually but in the meantime, if you need web serialization we 238 | accept pull requests 239 | * some queries that dynamically pull out `:spec-tacular/spec`s are no 240 | longer supported, use pull or `sd/query` instead of `sd/q` 241 | 242 | ## Short Term Roadmap 243 | 244 | * Create `defattr` that can be used as a field type to allow shared 245 | Datomic namespaces between fields of different specs 246 | 247 | ## License 248 | 249 | Copyright © 2014-2015 [Spark Community Investment](https://www.sparkfund.co) 250 | 251 | Distributed under the Apache License Version 2.0 252 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject spec-tacular "0.6.3" 2 | :description "First-class data specifications for Clojure and Datomic." 3 | :url "https://github.com/SparkFund/spec-tacular" 4 | :license {:name "Apache License, Version 2.0" 5 | :url "http://www.apache.org/licenses/LICENSE-2.0.html"} 6 | :dependencies [[org.clojure/clojure "1.8.0"] 7 | [com.datomic/datomic-free "0.9.5385" 8 | :exclusions [joda-time]] 9 | [prismatic/schema "0.2.4"] 10 | [org.clojure/test.check "0.9.0"] 11 | [org.clojure/tools.macro "0.1.2"] 12 | [org.clojure/core.typed "0.3.0" 13 | :exclusions [org.clojure/clojure]] 14 | [org.clojure/core.match "0.3.0-alpha4" 15 | :exclusions [org.ow2.asm/asm-all 16 | org.clojure/tools.analyzer 17 | org.clojure/tools.reader 18 | org.clojure/tools.analyzer.jvm]] 19 | [clojure-csv/clojure-csv "2.0.1"] 20 | [clj-time "0.9.0"]] 21 | :plugins [[lein-typed "0.3.5"]] 22 | :test-selectors {:default (complement :loud) 23 | :loud :loud 24 | :all (constantly true)} 25 | :core.typed {:check [spark.spec-tacular.schema 26 | spark.spec-tacular.typecheck-test]} 27 | :codox {:metadata {:doc/format :markdown} 28 | :source-paths ["src" "test"] 29 | :namespaces [spark.spec-tacular 30 | spark.spec-tacular.datomic 31 | spark.spec-tacular.schema 32 | spark.spec-tacular.generators] 33 | :source-uri "https://github.com/SparkFund/spec-tacular/blob/develop/{filepath}#L{line}"} 34 | :pedantic? :abort 35 | ) 36 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/datomic.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic 2 | {:doc "Datomic interface for the spec-tacular DSL" 3 | :core.typed {:collect-only true}} 4 | (:refer-clojure :exclude [for remove assoc!]) 5 | (:use spark.spec-tacular.spec 6 | spark.spec-tacular) 7 | (:require [clj-time.coerce :as timec] 8 | [clojure.core.typed :as t :refer [for]] 9 | [clojure.string :refer [lower-case]] 10 | [clojure.set :refer [rename-keys difference union]] 11 | [clojure.core.typed.unsafe :refer [ignore-with-unchecked-cast]] 12 | [clojure.data :as data] 13 | [clojure.walk :as walk] 14 | [clojure.core.match :refer [match]] 15 | [datomic.api :as db] 16 | [spark.spec-tacular.datomic.util :refer :all] 17 | [spark.spec-tacular.datomic.coerce :refer :all] 18 | [spark.spec-tacular.datomic.pull-helpers :refer :all] 19 | [spark.spec-tacular.datomic.query-helpers :refer :all]) 20 | (:import clojure.lang.MapEntry 21 | spark.spec_tacular.spec.Spec 22 | spark.spec_tacular.spec.EnumSpec 23 | (spark.spec_tacular.spec UnionSpec))) 24 | 25 | ;; ----------------------------------------------------------------------------- 26 | 27 | (t/defalias Database datomic.db.Db) 28 | (t/defalias DatabaseId datomic.db.DbId) 29 | 30 | (t/defalias Connection datomic.peer.LocalConnection) 31 | 32 | (t/defalias ConnCtx 33 | "A connection context. The only mandatory field is the `:conn`, 34 | which provides the actual connection to the database. 35 | 36 | Other option fields include: 37 | 38 | * `:transaction-log`, any object which can be converted to Datomic 39 | transaction data" 40 | (t/HMap :mandatory {:conn Connection} 41 | :optional {:transaction-log t/Any})) 42 | 43 | ;; ----------------------------------------------------------------------------- 44 | 45 | (def ^:no-doc spark-type-attr 46 | "The datomic attribute holding onto a keyword-valued SpecName" 47 | :spec-tacular/spec) 48 | 49 | (def ^{:no-doc true :private true} db-type->spec-type 50 | (reduce (t/ann-form #(assoc %1 %2 (keyword (name %2))) 51 | [(t/Map t/Keyword t/Keyword) t/Keyword -> (t/Map t/Keyword t/Keyword)]) {} 52 | [:db.type/keyword :db.type/string :db.type/boolean :db.type/long 53 | :db.type/bigint :db.type/float :db.type/double :db.type/bigdec 54 | :db.type/instant :db.type/uuid :db.type/uri :db.type/bytes])) 55 | 56 | (t/ann ^:no-check db [ConnCtx -> Database]) 57 | (defn db 58 | "Returns the database in a given connection context." 59 | [conn-ctx] 60 | (db/db (:conn conn-ctx))) 61 | 62 | (defmethod database-coercion datomic.query.EntityMap [em] 63 | (coerce-datomic-entity em)) 64 | 65 | (t/ann ^:no-check get-all-eids [datomic.db.Db SpecT -> (t/ASeq Long)]) 66 | (defn ^:no-doc get-all-eids 67 | "Retrives all of the eids described by the given spec from the database." 68 | [db spec] 69 | (t/let [mk-db-kw :- [Item -> t/Keyword] #(db-keyword spec %) 70 | names (map mk-db-kw (:items spec)) 71 | query '[:find ?eid :in $ [?attr ...] :where [?eid ?attr ?val]] 72 | ref->eid :- [(t/Vec t/Any) -> Long] 73 | ,#(let [r (first %)] (do (assert (instance? Long r)) r))] 74 | (map ref->eid (db/q query db names)))) 75 | 76 | (t/ann get-eid (t/IFn 77 | [Database SpecInstance -> (t/Option Long)] 78 | [Database SpecInstance SpecT -> (t/Option Long)])) 79 | (defn ^:no-doc get-eid 80 | "Returns an EID associated with the data in the given spark type if 81 | it exists in the database. Looks up according to identity 82 | items. Returns nil if not found." 83 | ([db sp] 84 | (when (map? sp) 85 | (when-let [spec (get-spec sp)] 86 | (get-eid db sp spec)))) 87 | ([db sp spec] 88 | (let [eid (or (get-in sp [:db-ref :eid]) (:eid (meta sp)))] 89 | (assert (or (nil? eid) (instance? Long eid))) 90 | (t/ann-form ; Seems like 'if' isn't typechecked correctly w/o annotation? 91 | (or eid 92 | (if-let [id (some (t/ann-form 93 | #(if-let [id (and (or (:identity? %) (:unique? %)) 94 | (get sp (:name %)))] 95 | [(db-keyword spec (:name %)) id]) 96 | [Item -> (t/Option (t/HVec [t/Keyword t/Any]))]) 97 | (:items spec))] 98 | (if-let [em (db/entity db id)] 99 | (:db/id em)))) 100 | (t/Option Long))))) 101 | 102 | (defmacro get-all-by-spec 103 | "Returns all the entities in the database with the given spec. 104 | 105 | If the spec is a keyword at compile-time, the resulting entity is 106 | cast to the correct type. Otherwise, the resulting entity is a 107 | generic [[SpecInstance]]" 108 | [db spec] 109 | `(let [spec# (get-spec ~spec) 110 | db# ~db 111 | _# (when-not spec# 112 | (throw (ex-info (str "Could not find spec for " ~spec) {:syntax '~spec}))) 113 | _# (when-not (instance? datomic.db.Db db#) 114 | (throw (ex-info (str "Expecting database") {:given db#}))) 115 | eids# (get-all-eids ~db spec#) 116 | eid->si# (clojure.core.typed.unsafe/ignore-with-unchecked-cast 117 | (fn [eid#] (recursive-ctor (:name (get-spec ~spec)) (db/entity ~db eid#))) 118 | [Long ~'-> ~(if (keyword? spec) (:type-symbol (get-type spec)) 119 | `SpecInstance)])] 120 | (map eid->si# eids#))) 121 | 122 | (defn count-all-by-spec 123 | "Returns the number of entities with the given spec in the database." 124 | [db spec] 125 | (assert (keyword? spec) "expecting spec name") 126 | (assert (instance? datomic.db.Db db) "expecting database") 127 | (or (ffirst (db/q {:find ['(count ?eid)] :in '[$] :where [['?eid :spec-tacular/spec spec]]} db)) 0)) 128 | 129 | (declare transaction-data) 130 | 131 | (defn transaction-log-data [conn-ctx] 132 | (when-let [tl (:transaction-log conn-ctx)] 133 | (let [eid (get-in tl [:db-ref :eid] (db/tempid :db.part/tx)) 134 | spec (get-spec tl)] 135 | (cons [:db/add eid :spec-tacular/spec (:name spec)] 136 | (transaction-data {} spec {:db-ref {:eid eid}} tl))))) 137 | 138 | (t/ann ^:no-check commit-transactions! 139 | [ConnCtx (t/ASeq t/Any) -> Long]) 140 | (defn ^:no-doc commit-transactions! 141 | "if :transaction-log is specified in conn-ctx (a regular sp object), 142 | we attach its attributes to the transaction." 143 | [conn-ctx transaction] 144 | (let [txn-log (transaction-log-data conn-ctx) 145 | tx @(db/transact (:conn conn-ctx) (concat transaction txn-log)) 146 | eid (->> transaction meta :eid) 147 | entid (db/resolve-tempid (db/db (:conn conn-ctx)) (:tempids tx) eid)] 148 | (or entid eid (:tempids tx)))) 149 | 150 | ;; ============================================================================= 151 | ;; query 152 | 153 | (defmacro q 154 | "Returns a set of results from the Datomic query. See [the 155 | README](https://github.com/SparkFund/spec-tacular/tree/v0.5.0#querying-databases) 156 | for examples. Also see [Datomic's 157 | documentation](http://docs.datomic.com/query.html) for query, which 158 | we both restrict and expand upon. 159 | 160 | ``` 161 | (q :find FIND-EXPR+ :in DB-EXPR :where CLAUSE+) 162 | 163 | FIND-EXPR = VAR 164 | | VAR . 165 | | (pull VAR pattern) 166 | | (instance SpecName ?variable) 167 | | (aggregate expr* VAR) 168 | | [VAR+ ] 169 | | [VAR ...] 170 | DB-EXPR | expr 171 | VAR = ?variable 172 | | SpecName 173 | CLAUSE = SPEC-CLAUSE 174 | | any otherwise valid Datomic clause 175 | SPEC-CLAUSE = [SpecName SPEC-RHS] 176 | | [?variable [SpecName SPEC-RHS]] 177 | SPEC-RHS = % | %n | SpecName 178 | | {keyword (SPEC-CLAUSE | expr),+} 179 | ``` 180 | 181 | Every `SpecName` must be a keyword at compile-time. Every 182 | `?variable` is quoted, so you do not have to quote them yourself. 183 | Anything `expr` that is not a `?variable` or a `SpecName` is left 184 | unchanged (so you can perform operations inside of queries as long 185 | as it does not confuse the query syntax). 186 | 187 | The `FIND-EXPR` are used as the `:find` arguments to the Datomic 188 | query. The syntax is the same, except we include `(instance 189 | SpecName ?variable)` for casting any database type to `SpecName` on 190 | its way off the database. This is done automatically for 191 | `FIND-EXPRS` that terminate with `SpecName`s rather than 192 | `?variable`s. The `aggregate` function must adhere to Datomic's 193 | requirements: either one of the build-in aggregators or a fully 194 | qualified function already imported into the namespace, where the 195 | aggregated variable is the final argument. 196 | 197 | The value of `:in` is used as the database; no other arguments to 198 | `:in` are allowed at the moment. 199 | 200 | Each `:where` clause is expanded to one or more Datomic clauses. 201 | All Datomic where clause syntax is (intended to be) supported. The 202 | `SPEC-CLAUSE` form finds spec-tacular instances on the database with 203 | the fields given in `SPEC-RHS`. 204 | 205 | Using `%` and `%n` is analogous to `#` and `%` in Clojure: `%` 206 | inserts the first `SpecName` in the `FIND-EXPR` if there is only 207 | one, or `%1` references the first, and `%2` the second, etc." 208 | [& stx] 209 | (let [{:keys [find-expr db-expr in-expr where-expr query-ret-type]} (parse-query stx) 210 | db (gensym 'db)] 211 | `(t/let [~db :- Database ~db-expr] 212 | (clojure.core.typed.unsafe/ignore-with-unchecked-cast 213 | (query {:find ~find-expr 214 | :in (cons ~''$ ~in-expr) 215 | :where ~where-expr} 216 | ~db) 217 | ~query-ret-type)))) 218 | 219 | ;; --------------------------------------------------------------------------------------------------- 220 | ;; query runtime 221 | 222 | (defn query 223 | "Runtime support for spec-tacular queries. Akin to the map syntax 224 | for `datomic.api/q`, this form expects data (rather than syntax), 225 | and attempts to unroll spec-tacular maps into valid Datomic 226 | `:where` clauses. 227 | 228 | ``` 229 | (query {:find FIND-EXPR :in IN-EXPR :where (WHERE-CLAUSE+)} expr+) 230 | 231 | FIND-EXPR = VAR 232 | | VAR . 233 | | (spec-pull VAR SpecName spec-tacular-pattern) 234 | | (pull VAR datomic-pattern) 235 | | (instance SpecName ?variable) 236 | | [VAR+ ] 237 | | [VAR ...] 238 | DB-EXPR | expr 239 | VAR = ?variable 240 | | SpecName 241 | CLAUSE = SPEC-CLAUSE 242 | | any otherwise valid Datomic clause 243 | SPEC-CLAUSE = [?variable SPEC-RHS] 244 | SPEC-RHS | {:spec-tacular/spec SpecName, 245 | keyword (?variable | constant | spec-instance),+} 246 | ``` 247 | 248 | Note that `SPEC-RHS` is no longer recursive via `SPEC-CLAUSE`. If 249 | `SpecName` names a UnionSpec, we create an `or` that tries every 250 | branch. 251 | 252 | If any `Exception`s occur enroute, a `clojure.lang.ExceptionInfo` is 253 | thrown with additional information about the query that was 254 | executed. 255 | 256 | This function uses `spark.spec-tacular.datomic.query-helpers` in 257 | order to datomify the `FIND-EXPR` and each `WHERE-CLAUSE`. 258 | " 259 | {:added "0.6.0"} 260 | [{find-elems :find clauses :where :as m} & args] 261 | (let [{:keys [datomic-find rebuild]} (datomify-find-elems find-elems) 262 | clauses (apply combine-where-clauses (map datomify-where-clause clauses)) 263 | [db & _] args 264 | query (assoc m :find datomic-find :where (case (first clauses) 265 | (and) (rest clauses) 266 | [clauses]))] 267 | (try (rebuild db (apply db/q query args)) 268 | (catch Exception e 269 | (throw (doto (ex-info "Encountered an error running Datomic query" 270 | {:query query :args args} 271 | e))))))) 272 | 273 | ;; ============================================================================= 274 | ;; database interfaces 275 | 276 | (declare transaction-data) 277 | (t/defalias ^:no-doc TransactionData (t/List (t/HVec [t/Keyword Long t/Keyword t/Any]))) 278 | 279 | (t/ann ^:no-check transaction-data-item 280 | [SpecT Long t/Any Item t/Any t/Any -> TransactionData]) 281 | (defn ^:no-doc transaction-data-item 282 | [parent-spec parent-eid txn-fns 283 | {iname :name required? :required? link? :link? [cardinality type] :type :as item} 284 | old new & [tmps]] 285 | (let [datomic-key (keyword (datomic-ns parent-spec) (name iname))] 286 | (letfn [(add [i] ;; adds i to field datomic-key in entity eid 287 | (when-not (some? i) 288 | (throw (ex-info "cannot add nil" {:spec (:name parent-spec) :old old :new new}))) 289 | (if-let [sub-eid (and (or link? (:component? item)) ; not by value 290 | (or (get-in i [:db-ref :eid]) 291 | (and tmps (some (fn [[k v]] 292 | (and (identical? k i) v)) 293 | @tmps))))] 294 | ;; adding by reference 295 | [[:db/add parent-eid datomic-key sub-eid]] 296 | ;; adding by value 297 | (if (= (recursiveness item) :non-rec) 298 | (let [sub-spec (get-spec type) 299 | i (if (= type :calendarday) (timec/to-date i) i)] 300 | (if-let [fn (get-in txn-fns [parent-spec iname])] 301 | [[fn parent-eid datomic-key i]] 302 | [[:db/add parent-eid datomic-key i]])) 303 | (let [sub-eid (db/tempid (or (:part parent-eid) :db.part/user)) 304 | _ (when (and tmps link?) 305 | (swap! tmps conj [i sub-eid])) 306 | sub-spec (get-spec type) 307 | sub-spec (if (:elements sub-spec) 308 | (get-spec i) sub-spec)] 309 | (concat (when (and (:component? item) (= cardinality :one) (some? old)) 310 | [[:db.fn/retractEntity (get-in old [:db-ref :eid])]]) 311 | [[:db/add parent-eid datomic-key sub-eid] 312 | [:db/add sub-eid :spec-tacular/spec (:name sub-spec)]] 313 | (transaction-data txn-fns sub-spec {:db-ref {:eid sub-eid}} i tmps)))))) 314 | (retract [i] ;; removes i from field datomic-key in entity eid 315 | (when (not (some? i)) 316 | (throw (ex-info "cannot retract nil" 317 | {:spec (:name parent-spec) :old old :new new}))) 318 | (when required? 319 | (throw (ex-info "attempt to delete a required field" 320 | {:item item :field iname :spec parent-spec}))) 321 | (if-let [eid (get-in i [:db-ref :eid])] 322 | (if (:component? item) 323 | [[:db.fn/retractEntity eid]] 324 | [[:db/retract parent-eid datomic-key eid]]) 325 | (do (let [sub-spec (get-spec type)] 326 | (when (and link? (not (instance? EnumSpec sub-spec))) 327 | (throw (ex-info "retracted link missing eid" {:entity i})))) 328 | (let [i (if (= type :calendarday) (timec/to-date i) i)] 329 | [[:db/retract parent-eid datomic-key i]]))))] 330 | (cond 331 | (= cardinality :one) 332 | ,(cond 333 | (some? new) (add new) 334 | (some? old) (retract old) 335 | :else []) 336 | (= (recursiveness item) :non-rec) 337 | ,(do (when-not (apply distinct? nil new) 338 | (throw (ex-info "adding identical" {:new new}))) 339 | (let [[adds deletes both] (data/diff (set new) (set old))] 340 | (concat (mapcat retract deletes) 341 | (mapcat add adds)))) 342 | :else 343 | ;; this is a bit tricky: 344 | ;; -- group things from old and new by eid, resulting in 345 | ;; {123 [], 456 [ ], .... 346 | ;; (gensym) [], ....} 347 | ;; -- if there are two things in the list, do nothing 348 | ;; -- if there is one thing in the list, either remove or add depending 349 | ;; on which group (old or new) the entity came from 350 | ;; -- new entities won't have eids, so just give them something unique 351 | ;; to key on and add them 352 | (let [by-eids (group-by #(get-in % [:db-ref :eid] (gensym)) (concat old new))] 353 | (->> (for [[_ [e1 & [e2]]] by-eids] 354 | (if e2 [] 355 | (if (some #(identical? e1 %) old) 356 | (retract e1) (add e1)))) 357 | (apply concat))))))) 358 | 359 | (t/ann ^:no-check transaction-data 360 | [SpecT t/Any (t/Map t/Keyword t/Any) -> TransactionData]) 361 | (defn ^:no-doc transaction-data [txn-fns spec old-si updates & [tmps]] 362 | "Given a possibly nil, possibly out of date old entity. 363 | Returns the transaction data to do the desired updates to something of type spec." 364 | (if-let [eid (when (and (nil? old-si) tmps) 365 | (some (fn [[k v]] (and (identical? k updates) v)) @tmps))] 366 | (with-meta [] {:eid eid}) 367 | (let [eid (or (get-in old-si [:db-ref :eid]) 368 | (db/tempid :db.part/user))] 369 | (when-not spec 370 | (throw (ex-info "spec missing" {:old old-si :updates updates}))) 371 | (let [diff (clojure.set/difference (disj (set (keys updates)) :db-ref) 372 | (set (map :name (:items spec))))] 373 | (when-not (empty? diff) 374 | (throw (ex-info "Cannot add keys not in the spec." {:keys diff})))) 375 | (->> (for [{iname :name :as item} (:items spec) 376 | :when (contains? updates iname)] 377 | (transaction-data-item spec eid txn-fns item (iname old-si) (iname updates) tmps)) 378 | (apply concat) 379 | (#(if (get-in old-si [:db-ref :eid]) % 380 | (cons [:db/add eid :spec-tacular/spec (:name spec)] %))) 381 | (#(do (when (and tmps (get-spec updates)) 382 | (swap! tmps conj [updates eid])) %)) 383 | (#(with-meta % (assoc (meta %) :eid eid))))))) 384 | 385 | (t/ann ^:no-check graph-transaction-data [ConnCtx t/Coll -> TransactionData]) 386 | (defn graph-transaction-data 387 | "Returns Datomic transaction data that would create the given graph 388 | on the database given in `conn-ctx`. Also contains meta-data 389 | `:tmpids` and `:specs` for the expected temp-ids and specs, respectively." 390 | [conn-ctx new-si-coll] 391 | (let [tmps (atom []) 392 | specs (map get-spec new-si-coll) 393 | data (let [db (db/db (:conn conn-ctx))] 394 | (map (fn [si spec] 395 | (when-not spec 396 | (throw (ex-info "could not find spec" {:entity si}))) 397 | (when (or (get si :db-ref) (get-eid db si)) 398 | (throw (ex-info "entity already in database" {:entity si}))) 399 | (transaction-data (:txn-fns conn-ctx) spec nil si tmps)) 400 | new-si-coll specs)) 401 | tmpids (map (comp :eid meta) data) 402 | data (apply concat data) 403 | log-data (transaction-log-data conn-ctx)] 404 | (with-meta (concat data log-data) {:tmpids tmpids :specs specs}))) 405 | 406 | (t/ann ^:no-check instance-transaction-data [ConnCtx t/Any -> TransactionData]) 407 | (defn instance-transaction-data 408 | "Returns the Datomic transaction data that would create the given 409 | spec instance on the database given in `conn-ctx`." 410 | [conn-ctx new-si] 411 | (let [data (graph-transaction-data conn-ctx [new-si]) 412 | {:keys [tmpids specs]} (meta data)] 413 | (with-meta data {:tmpid (first tmpids) :spec (first specs)}))) 414 | 415 | (t/ann ^:no-check create-graph! (t/All [a] [ConnCtx a -> a])) 416 | (defn create-graph! 417 | "Creates every new instance contained in the given collection, and 418 | returns the new instances in a collection of the same type, and in 419 | the same order where applicable. For every object that is 420 | `identical?` in the given graph, only one instance is created on the 421 | database. 422 | 423 | create-graph! does *not* support arbitrarly nested collections. 424 | 425 | Currently supports sets, lists, vector, and sequences. 426 | 427 | Aborts if any entities already exist on the database." 428 | [conn-ctx new-si-coll] 429 | (let [data (graph-transaction-data conn-ctx new-si-coll) 430 | {:keys [tmpids specs]} (meta data) 431 | txn-result (try @(db/transact (:conn conn-ctx) data) 432 | (catch java.util.concurrent.ExecutionException e 433 | (throw (ex-info "Encountered an error during Datomic transaction" 434 | {:data data} e))))] 435 | ;; db side effect has occurred 436 | (let [db (db/db (:conn conn-ctx)) 437 | db-si-coll (map #(some->> (db/resolve-tempid db (:tempids txn-result) %1) 438 | (db/entity db) 439 | (recursive-ctor (:name %2))) 440 | tmpids specs) 441 | constructor (condp #(%1 %2) new-si-coll 442 | set? set, list? list, vector? vec, seq? seq 443 | (throw (ex-info "Cannot recreate" {:type (type new-si-coll)})))] 444 | (constructor db-si-coll)))) 445 | 446 | (t/ann ^:no-check create! (t/All [a] [ConnCtx a -> a])) 447 | (defn create! 448 | "Creates a new instance of the given entity on the database in the 449 | given connection context. Returns a representation of the newly 450 | created object. 451 | 452 | Get the Datomic `:db/id` from the object using the `:db-ref` field. 453 | 454 | Aborts if the entity already exists in the database (use [[assoc!]] instead)." 455 | [conn-ctx new-si] 456 | (first (create-graph! conn-ctx [new-si]))) 457 | 458 | (t/ann ^:no-check assoc! (t/All [a] [ConnCtx a t/Keyword t/Any -> a])) 459 | (defn assoc! 460 | "Updates the given entity in database in the given connection. 461 | Returns the new entity. 462 | 463 | The entity must be an object representation of an entity on the 464 | database (for example, returned from a query, [[create!]], or an 465 | earlier [[assoc!]]). 466 | 467 | *Attempting to retract a `:component` field (by setting that field 468 | to `nil`) retracts the entire component instance.* 469 | 470 | Get the Datomic `:db/id` from the object using the `:db-ref` field. 471 | 472 | Aborts if the entity does not exist in the database (use [[create!]] instead)." 473 | [conn-ctx si & {:as updates}] 474 | (when-not (get si :db-ref) 475 | (throw (ex-info "entity must be on database already" {:entity si}))) 476 | (let [spec (get-spec si) 477 | eid (->> (transaction-data (:txn-fns conn-ctx) 478 | spec 479 | si 480 | updates) 481 | (commit-transactions! conn-ctx))] 482 | (->> (db/entity (db/db (:conn conn-ctx)) eid) 483 | (recursive-ctor (:name spec))))) 484 | 485 | (t/ann ^:no-check update! (t/All [a] [ConnCtx a a -> a])) 486 | (defn update! 487 | "Calculate a shallow difference between the two spec instances and 488 | uses [[assoc!]] to change the entity on the database." 489 | [conn-ctx si-old si-new] 490 | (let [updates (mapcat (fn [[k v]] [k v]) si-new)] 491 | (if (empty? updates) si-old 492 | (if (not (even? (count updates))) 493 | (throw (ex-info "malformed updates -- expecting keyword-value pairs" 494 | {:updates updates})) 495 | (apply assoc! conn-ctx si-old updates))))) 496 | 497 | (t/ann ^:no-check refresh (t/All [a] [ConnCtx a -> a])) 498 | (defn refresh 499 | "Returns an updated representation of the Datomic entity at the 500 | given instance's `:db-ref`. 501 | 502 | The entity must be an object representation of an entity on the 503 | database (see [[assoc!]] for an explanation)." 504 | [conn-ctx si] 505 | (let [eid (get-in si [:db-ref :eid]) 506 | spec (get-spec si)] 507 | (when-not eid (throw (ex-info "entity without identity" {:entity si}))) 508 | (when-not spec (throw (ex-info "entity without spec" {:entity si}))) 509 | (let [em (db/entity (db/db (:conn conn-ctx)) eid)] 510 | (recursive-ctor (:name spec) em)))) 511 | 512 | (t/ann ^:no-check retract! (t/IFn [ConnCtx t/Any -> nil] 513 | [ConnCtx t/Any t/Keyword -> nil])) 514 | (defn retract! 515 | "Removes the given instance from the database using 516 | `:db.fn/retractEntity`. Returns `nil`." 517 | {:added "0.5.1"} 518 | [conn-ctx si & [field-name]] 519 | (if field-name 520 | (assoc! conn-ctx si field-name nil) 521 | (let [eid (get-in si [:db-ref :eid])] 522 | (when-not eid (throw (ex-info "entity not on database" {:entity si}))) 523 | (let [data [[:db.fn/retractEntity eid]] 524 | log-data (transaction-log-data conn-ctx)] 525 | (do (commit-transactions! conn-ctx (concat data log-data)) nil))))) 526 | 527 | (defn backwards [spec-name kw] 528 | (let [spec (get-spec spec-name) 529 | item (get-item spec kw)] 530 | (assoc item :parent-name spec-name))) 531 | 532 | (defn pull 533 | "Executes a Datomic pull after datomifying the given pattern with 534 | respect to the given instance." 535 | [db pattern instance] 536 | (let [eid (get-eid db instance) 537 | spec (get-spec instance)] 538 | (assert (vector? pattern)) 539 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern spec pattern)] 540 | (->> (db/pull db datomic-pattern eid) 541 | (rebuild db))))) 542 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/datomic/coerce.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.coerce 2 | (:require [spark.spec-tacular :refer [get-spec]] 3 | [spark.spec-tacular.datomic.util :refer [db-keyword]]) 4 | (:import (spark.spec_tacular.spec EnumSpec))) 5 | 6 | (defn coerce-datomic-entity [em] 7 | (if-let [spec (get-spec em)] ;; Spec 8 | (do (when-not (every? (fn [kw] (some #(= (db-keyword spec (:name %)) kw) (:items spec))) 9 | (filter #(case % (:spec-tacular/spec :db/id :db/txInstant) false true) 10 | (keys em))) 11 | (throw (ex-info "bad entity in database" {:entity em}))) 12 | (->> (for [{iname :name :as item} (:items spec)] 13 | [iname (get em (db-keyword spec iname))]) 14 | (cons [:db-ref {:eid (:db/id em)}]) 15 | (cons [:spec-tacular/spec (:name spec)]) 16 | (filter (comp some? second)) 17 | (into {}))) 18 | (if-let [kw (:db/ident em)] ;; EnumSpec 19 | (do (when-not (keyword? kw) 20 | (throw (ex-info "bad enum in database" {:entity em}))) 21 | (if-let [spec (get-spec kw)] 22 | (if (instance? EnumSpec spec) kw 23 | (throw (ex-info "bad enum in database" {:entity em}))))) 24 | (throw (ex-info "bad entity in database" {:entity em}))))) 25 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/datomic/deprecated.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.deprecated 2 | "old functionality of spark.spec-tacular.datomic, retained only 3 | until we can port deprecated tests over to newer functionality" 4 | (:refer-clojure :exclude [assoc!]) 5 | (:require [clojure.core.typed :as t] 6 | [clojure.data :as data] 7 | [clojure.set :refer [rename-keys]] 8 | [clojure.walk :as walk] 9 | [datomic.api :as db] 10 | [spark.spec-tacular :refer :all] 11 | [spark.spec-tacular.datomic :refer :all] 12 | [spark.spec-tacular.datomic.util :refer :all]) 13 | (:import clojure.lang.MapEntry)) 14 | 15 | (t/defalias Mask (t/Rec [mask] (t/Map t/Keyword (t/U mask t/Bool)))) 16 | 17 | (defn db->sp ;; TODO -- this function is pointless now 18 | [db ent & [sp-type]] 19 | (if-not ent 20 | nil 21 | (let [eid (:db/id ent) 22 | ent (into {} ent) 23 | spec (get-spec (spark-type-attr ent)) 24 | ctor (get-ctor (:name spec)) 25 | reduce-attr->kw #(assoc %1 (db-keyword spec %2) (-> %2 name keyword)) 26 | val (rename-keys ent (reduce reduce-attr->kw {} (map :name (:items spec)))) 27 | val (reduce (fn [m {iname :name [cardinality typ] :type :as item}] 28 | (let [v (get val iname)] 29 | (if (nil? v) 30 | (assoc m iname ; explicitly list nils for missing values 31 | (case cardinality 32 | :one nil 33 | :many (list))) 34 | (case (recursiveness item) 35 | :rec (assoc m iname 36 | (case cardinality 37 | :one (db->sp db v typ) 38 | :many (map #(db->sp db % typ) v))) 39 | :non-rec m)))) 40 | val (:items spec))] 41 | (assert ctor (str "No ctor found for " (:name spec))) 42 | (-> (ctor val) 43 | (assoc :db-ref {:eid eid}) 44 | (dissoc spark-type-attr))))) 45 | 46 | (defn get-by-eid ;; TODO -- clean up uses of this function in user code 47 | "fetches the entire SpecInstance from the db for the given eid 48 | throws IllegalArgumentException when eid isn't found." 49 | [db eid & [sp-type]] 50 | (do (assert (instance? java.lang.Long eid) 51 | (str eid " is not an eid")) 52 | (db->sp db (db/entity db eid) sp-type))) 53 | 54 | (t/ann ^:no-check build-transactions 55 | (t/IFn [datomic.db.Db SpecInstance Mask (t/Atom1 (t/ASeq (t/Vec t/Any))) -> (t/Map t/Keyword t/Any)] 56 | [datomic.db.Db SpecInstance Mask (t/Atom1 (t/ASeq (t/Vec t/Any))) SpecT -> (t/Map t/Keyword t/Any)])) 57 | (defn build-transactions 58 | "Builds a nested datomic-data datastructure for the sp data, only 59 | for what's specified in the mask. Adds Datomicy deletion commands to 60 | the given atomic list of deletions when appropriate." 61 | [db sp mask deletions & [spec]] 62 | (let [spec (or spec (get-spec sp)) 63 | [spec mask] (if (:elements spec) ; Need to pick which union branch to pick in the mask. 64 | (let [sub-name (:name (get-spec sp))] 65 | [(get-spec (get-in spec [:elements sub-name])) 66 | (get mask sub-name)]) 67 | [spec mask]) 68 | eid (get-eid db sp) 69 | db-value (and eid (get-by-eid db eid (:name spec))) 70 | eid (or eid (db/tempid :db.part/user))] 71 | (->> (for [{iname :name 72 | [cardinality type] :type 73 | required? :required? 74 | link? :link? 75 | :as item} 76 | (:items spec) 77 | :when (iname mask) 78 | :let [is-nested (= (recursiveness item) :rec) 79 | is-many (= cardinality :many) 80 | ival (iname sp) 81 | ival (if (or link? (not (:db-ref ival))) ival (dissoc ival :db-ref)) 82 | sub-spec (get-spec type) ; Not necessarily ival's spec: could be an union. 83 | mask (iname mask) 84 | ival-db (iname db-value) 85 | datomic-key (keyword (datomic-ns spec) (name iname)) 86 | retract (fn [r] 87 | (if required? 88 | (throw (ex-info "attempt to delete a required field" 89 | {:item item :field iname :spec spec})) 90 | [:db/retract eid datomic-key 91 | (or (get-in r [:db-ref :eid]) r)]))]] 92 | (do 93 | [datomic-key 94 | (if is-nested 95 | (if (map? mask) 96 | (if is-many 97 | (let [old-eids (set (map (partial get-eid db) ival-db)) 98 | new-eids (set (map (partial get-eid db) ival)) 99 | [_ deletes _] (data/diff new-eids old-eids)] 100 | (swap! deletions concat (map retract deletes)) 101 | (set (map #(build-transactions db % mask deletions sub-spec) 102 | ival))) 103 | (if (some? ival) 104 | (build-transactions db ival mask deletions sub-spec) 105 | (if (some? ival-db) 106 | (do (swap! deletions conj (retract ival-db)) nil) 107 | nil))) 108 | (if is-many 109 | (let [old-eids (set (map (partial get-eid db) ival-db)) 110 | new-eids (set (map (partial get-eid db) ival)) 111 | [adds deletes _] (data/diff new-eids old-eids)] 112 | (swap! deletions concat (map retract deletes)) 113 | adds) 114 | (if (some? ival) 115 | (get-eid db ival) 116 | (if (some? ival-db) 117 | (do (swap! deletions conj (retract ival-db)) nil) 118 | nil)))) 119 | (if is-many 120 | (let [[adds deletes] (data/diff ival ival-db)] 121 | (swap! deletions concat (map retract deletes)) 122 | adds) 123 | (if (some? ival) 124 | ival 125 | (if (some? ival-db) 126 | (do (swap! deletions conj (retract ival-db)) nil) 127 | nil))))])) 128 | (filter (fn [[_ v]] (some? v))) 129 | (into {}) 130 | (#(assoc % :db/id eid)) 131 | (#(assoc % spark-type-attr (:name spec))) 132 | (#(with-meta % {:eid eid}))))) 133 | 134 | (t/ann ^:no-check union-masks (t/IFn [-> (t/Val nil)] 135 | [(t/Option Mask) -> (t/Option Mask)] 136 | [(t/Option Mask) (t/Option Mask) -> (t/Option Mask)])) 137 | (defn union-masks 138 | "union (join) taken w.r.t. a lattice of 'specificity' eg -- nil < true < {:item ...} 139 | (recall 'true' means the mask consisting only of the db-ref) 140 | keys are combined and their values are recursively summed. 141 | Unions and Records can be summed the same, as we represent both with maps." 142 | ([] nil) 143 | ([m] m) 144 | ([ma mb] 145 | (cond 146 | (and (map? ma) (map? mb)) 147 | (merge-with union-masks ma mb) 148 | (map? ma) ma 149 | (map? mb) mb 150 | :else (or ma mb)))) 151 | 152 | (t/ann ^:no-check shallow-mask [SpecT -> Mask]) 153 | (defn shallow-mask 154 | "Builds a mask-map of the given spec for consumption by 155 | build-transactions. Only lets top-level and is-component fields 156 | through." 157 | [spec] 158 | (if (:elements spec) 159 | (into {} (map #(vector % true) (:elements spec))) 160 | (->> (for [{iname :name 161 | [_ typ] :type 162 | is-component :is-component? 163 | :as item} (:items spec)] 164 | [iname 165 | (if is-component 166 | (shallow-mask (get-spec typ)) 167 | true)]) 168 | (into {})))) 169 | 170 | (t/ann ^:no-check shallow-plus-unions-mask [SpecT -> Mask]) 171 | (defn shallow-plus-unions-mask 172 | "Builds a mask-map of the given spec for consumption by 173 | build-transactions. Only lets top-level and is-component fields 174 | through As well, expands toplevel unions and any union members which 175 | have only primitive fields(intended to catch common cases like 176 | 'status' unions where the options have no interesting fields)." 177 | [spec] 178 | (let [is-leaf? (fn [sp-name] 179 | (let [spec (get-spec sp-name)] 180 | (and (:items spec) 181 | (every? primitive? 182 | (map #(second (:type %)) (:items spec))))))] 183 | (if (:elements spec) 184 | (into {} (map #(if (is-leaf? %) 185 | [% (shallow-mask (get-spec %))] ; one more step is enough to expand leafy records 186 | [% true]) 187 | (:elements spec))) 188 | (->> (for [{iname :name 189 | [_ typ] :type 190 | is-component :is-component? 191 | :as item} (:items spec)] 192 | (let [sub-sp (get-spec typ)] 193 | [iname 194 | (if (:elements sub-sp) 195 | (shallow-plus-unions-mask sub-sp) ;toplevel unions can be leaf-expanded 196 | true)])) 197 | (into {}))))) 198 | 199 | (t/ann ^:no-check new-components-mask [SpecInstance SpecT -> Mask]) 200 | (defn new-components-mask 201 | "Builds a mask that specifies only adding entities that don't already 202 | have eids. Any value with an eid will be treaded as an association and 203 | will not result in any updates to the properties of that object in the 204 | transaction. 205 | Spec is generated from a particular sp value, not just the value's spec." 206 | [sp spec] 207 | (if (:elements spec) 208 | (let [sub-sp (get-spec sp)] 209 | {(:name sub-sp) (new-components-mask sp sub-sp)}) ; only need to specify the actual type for the union branch. 210 | (if (get-in sp [:db-ref :eid]) 211 | true ;treat as a ref, already in db 212 | (if-let [spec (get-spec sp)] 213 | (->> (for [{iname :name [_ type] :type :as item} (:items spec)] 214 | [iname (new-components-mask (get sp iname) type)]) 215 | (into {})) 216 | true)))) ;primitive 217 | 218 | (t/ann ^:no-check depth-n-mask [SpecT t/AnyInteger -> Mask]) 219 | (defn depth-n-mask 220 | [spec n] 221 | (if (= n 0) 222 | (shallow-mask spec) 223 | (if (:elements spec) 224 | (into {} (map #(vector % (depth-n-mask (get-spec %) (dec n))) (:elements spec))) 225 | (->> (for [{iname :name 226 | [_ typ] :type 227 | is-component :is-component? 228 | :as item} (:items spec)] 229 | [iname 230 | (if (= (recursiveness item) :rec) 231 | (depth-n-mask (get-spec typ) 232 | (if is-component n (dec n))) ; components don't count as depth-increasing 233 | true)]) 234 | (into {}))))) 235 | 236 | 237 | (declare complete-mask) 238 | 239 | (t/ann-datatype CompleteMask [spec :- SpecT]) 240 | (t/tc-ignore 241 | (deftype CompleteMask [spec] 242 | clojure.lang.IPersistentMap 243 | (assoc [_ k v] 244 | (throw (ex-info "Mask function not implemented." {:name "assoc"}))) 245 | (assocEx [_ k v] 246 | (throw (ex-info "Mask function not implemented." {:name "assocEx"}))) 247 | (without [_ k] 248 | (throw (ex-info "Mask function not implemented." {:name "without"}))) 249 | clojure.lang.Associative 250 | (containsKey [_ k] 251 | (if (:elements spec) 252 | (contains? (:elements spec) k) 253 | (not-empty (filter #(= (:name %) k) (:items spec))))) 254 | (entryAt [_ k] 255 | (if (:elements spec) 256 | (if (contains? (:elements spec) k) 257 | (MapEntry. k (complete-mask (get-spec k)))) 258 | (let [{iname :name 259 | [_ typ] :type 260 | :as item} (first (filter #(= (:name %) k) (:items spec))) 261 | is-nested (= :rec (recursiveness item))] 262 | (MapEntry. k (when (some? item) 263 | (if is-nested (complete-mask (get-spec typ)) true)))))) 264 | clojure.lang.ILookup 265 | (valAt [t k] (when-let [e (.entryAt t k)] (.val e))) 266 | (valAt [t k default] (if-let [e (.entryAt t k)] (.val e) default)))) 267 | 268 | (t/ann ^:no-check complete-mask [SpecT -> Mask]) 269 | (defn complete-mask [spec] 270 | "Builds a mask-map of the given spec for consumption by 271 | build-transactions. Recurs down specs to add everything in 272 | time." 273 | (CompleteMask. spec)) 274 | 275 | (t/ann ^:no-check sp->transactions 276 | (t/IFn [datomic.db.DbId SpecInstance -> (t/ASeq t/Any)] 277 | [datomic.db.DbId SpecInstance t/Bool -> (t/ASeq t/Any)])) 278 | (defn sp->transactions 279 | "Returns a vector for datomic.api/transact that persist the given 280 | specced value sp to the database, according to the given db. If 281 | called with the optional shallow? argument, will persist according 282 | to the shallow-mask function, otherwise will persist the entire 283 | datastructure." 284 | [db sp & [shallow?]] 285 | (let [deletions (atom '()) 286 | mask ((if shallow? shallow-mask complete-mask) (get-spec sp)) 287 | datomic-data (build-transactions db sp mask deletions)] 288 | (with-meta 289 | (cons datomic-data @deletions) 290 | (meta datomic-data)))) 291 | 292 | (t/ann ^:no-check commit-sp-transactions! 293 | [ConnCtx (t/ASeq t/Any) -> Long]) 294 | (defn ^:no-doc commit-sp-transactions! 295 | "if :transaction-log is specified in conn-ctx (a regular sp object), 296 | we attach its attributes to the transaction." 297 | [conn-ctx transaction] 298 | (let [txn-id (db/tempid :db.part/tx) 299 | txn-log (when-let [tl (:transaction-log conn-ctx)] 300 | (->> (sp->transactions (db/db (:conn conn-ctx)) tl) ; hijack db/id to point to txn. 301 | (map #(assoc % :db/id txn-id)))) 302 | tx @(db/transact (:conn conn-ctx) (concat transaction txn-log)) 303 | eid (->> transaction meta :eid) 304 | entid (db/resolve-tempid (db/db (:conn conn-ctx)) (:tempids tx) eid)] 305 | (or entid eid (:tempids tx)))) 306 | 307 | (t/ann ^:no-check create-sp! [ConnCtx SpecInstance -> Long]) 308 | (defn create-sp! 309 | "aborts if sp is already in db. 310 | if successful, returns the eid of the newly-added entity." 311 | [conn-ctx new-sp] 312 | (let [spec (get-spec new-sp) 313 | db (db/db (:conn conn-ctx))] 314 | (assert (not (get-eid db new-sp)) 315 | "object must not already be in the db") 316 | (commit-sp-transactions! conn-ctx (sp->transactions db new-sp)))) 317 | 318 | (t/ann ^:no-check masked-create-sp! 319 | [ConnCtx SpecInstance Mask -> Long]) 320 | (defn masked-create-sp! 321 | "Ensures sp is not in the db prior to creating. aborts if so." 322 | [conn-ctx sp mask] 323 | (let [spec (get-spec sp) 324 | db (db/db (:conn conn-ctx)) 325 | _ (assert (not (get-eid db sp)) 326 | "object must not already be in the db") 327 | deletions (atom '()) 328 | datomic-data (build-transactions db sp mask deletions) 329 | txns (with-meta 330 | (cons datomic-data @deletions) 331 | (meta datomic-data))] 332 | (commit-sp-transactions! conn-ctx txns))) 333 | 334 | (t/ann ^:no-check sp-filter-with-mask 335 | [Mask SpecT SpecInstance -> (t/Option SpecInstance)]) 336 | (defn sp-filter-with-mask 337 | "applies a mask to a sp instance, keeping only the keys mentioned, 338 | (including any relevant :db-id keys)" 339 | [mask spec-name sp] 340 | (let [spec (get-spec spec-name)] 341 | (if (some? spec) 342 | (let [filter-one 343 | , (fn [sp] 344 | (if (= true mask) 345 | (reduce (fn [a k] (if (= :db-ref k) a (dissoc a k))) 346 | sp (keys sp)) 347 | (if (map? mask) 348 | (if (:elements spec) 349 | (let [sub-spec-name (:name (get-spec sp))] 350 | (sp-filter-with-mask (get mask sub-spec-name) 351 | sub-spec-name sp)) 352 | (let [kept-keys (into #{} (keys mask))] 353 | (reduce 354 | (fn [a k] 355 | (if (kept-keys k) 356 | (assoc a k (sp-filter-with-mask 357 | (get mask k) 358 | (->> (:items spec) 359 | (filter #(= k (:name %)) ) 360 | (first) 361 | (:type) 362 | (second)) 363 | (get sp k))) 364 | (if (= :db-ref k) 365 | a 366 | (dissoc a k)))) 367 | sp (keys sp)))) 368 | nil)))] 369 | (if (and (coll? sp) (not (map? sp))) 370 | (filter identity (map filter-one sp)) ;; don't let nils thru 371 | (filter-one sp))) 372 | (if (= true mask) 373 | sp 374 | nil)))) 375 | 376 | ; TODO consider replocing the old "update-sp" etc with something more explicitly masked like this? 377 | (t/ann ^:no-check masked-update-sp! 378 | [ConnCtx SpecInstance Mask -> Long]) 379 | (defn masked-update-sp! 380 | "Ensures sp is in the db prior to updating. aborts if not." 381 | [conn-ctx sp mask] 382 | (let [db (db/db (:conn conn-ctx)) 383 | _ (assert (db/entity db (get-in sp [:db-ref :eid])) "Entity must exist in DB before updating.") 384 | deletions (atom '()) 385 | datomic-data (build-transactions db sp mask deletions) 386 | txns (with-meta 387 | (cons datomic-data @deletions) 388 | (meta datomic-data))] 389 | (commit-sp-transactions! conn-ctx txns))) 390 | 391 | (t/ann ^:no-check remove-eids [SpecInstance -> SpecInstance]) 392 | (defn remove-eids 393 | "recursively strip all entries of :db-ref {:eid ...} from sp. 394 | can be used for checking equality with a non-db value." 395 | [sp] 396 | (walk/postwalk (fn [m] (if (get m :db-ref) (dissoc m :db-ref) m)) sp)) 397 | 398 | (t/ann ^:no-check remove-identity-items [SpecT SpecInstance -> SpecInstance]) 399 | (defn remove-identity-items 400 | "recursively walks a sp and removes any :unique? or :identity? 401 | items (as those are harder to test.) We do want to come up with some 402 | sensible :identity? tests at some point though." 403 | [spec-name sp] 404 | (let [spec (get-spec spec-name)] 405 | (if (and (some? spec) (and (some? sp) 406 | (if (and (coll? sp) (not (map? sp))) 407 | (not-empty sp) 408 | true))) 409 | (if (:elements spec) 410 | (let [union-remove (fn [sp-item] 411 | (remove-identity-items (:name (get-spec sp-item)) 412 | sp-item))] 413 | (if (and (coll? sp) (not (map? sp))) 414 | (into (empty sp) (map union-remove sp)) 415 | (union-remove sp))) 416 | (let [item-remove 417 | , (fn [sp-item] 418 | (reduce 419 | (fn [it {:keys [unique? identity?] 420 | iname :name 421 | [_ sub-spec-name] :type}] 422 | (if (or unique? identity?) 423 | (dissoc it iname) ; drop unique fields 424 | (assoc it iname 425 | (remove-identity-items sub-spec-name 426 | (get sp-item iname))))) 427 | sp-item (:items spec)))] 428 | (if (and (coll? sp) (not (map? sp))) 429 | (into (empty sp) (map item-remove sp)) 430 | (item-remove sp)))) 431 | sp))) 432 | 433 | ; TODO we could make it actually remove the keys instead of nil them, need a helper with some sentinal probably easiest? 434 | ; also we probably want to only strip these on nested things, not the toplevel thing. (i.e. THIS is the helper already.) 435 | (t/ann ^:no-check remove-items-with-required [SpecInstance -> SpecInstance]) 436 | (defn remove-items-with-required 437 | "recursively walks a sp and removes any sub things that have 438 | required fields in the spec. Another tricky-to-test updates helper. (including top-level)" 439 | [sp] 440 | (if (and (coll? sp) (not (map? sp))) 441 | (into (empty sp) (clojure.core/remove #(= % ::remove-me) (map remove-items-with-required sp))) 442 | (let [spec (get-spec sp)] 443 | (if (and (some? spec) (and (some? sp) 444 | (if (and (coll? sp) (not (map? sp))) 445 | (not-empty sp) 446 | true))) 447 | (if (some identity (map :required? (:items spec))) 448 | ::remove-me 449 | (reduce 450 | (fn [it [sub-name sub-val]] 451 | (let [rec-val (remove-items-with-required sub-val)] 452 | (if (= ::remove-me rec-val) 453 | (dissoc it sub-name) 454 | (assoc it sub-name 455 | rec-val)))) 456 | sp sp)) 457 | sp)))) 458 | 459 | ;; TODO probably shouldnt live here 460 | (t/ann ^:no-check remove-sub-items-with-required [SpecInstance -> SpecInstance]) 461 | (defn remove-sub-items-with-required 462 | "recursively walks a single (map) sp and removes any sub-sps that 463 | have required fields in the spec (but not the toplevel one, only 464 | sub-items). Another tricky-to-test updates helper. Also, remove any 465 | top-level attributes that are required but have nil values." 466 | [sp] 467 | (let [spec (get-spec sp)] 468 | (assert (nil? (:elements sp))) 469 | (if (and (some? spec) (and (some? sp) 470 | (if (and (coll? sp) (not (map? sp))) 471 | (not-empty sp) 472 | true))) 473 | (reduce 474 | (fn [it {:keys [required?] sub-name :name}] ; [sub-name sub-val] 475 | (if (contains? sp sub-name) 476 | (let [rec-val (remove-items-with-required (get sp sub-name))] 477 | (if (or (and required? (nil? rec-val)) 478 | (= ::remove-me rec-val)) 479 | (dissoc it sub-name) 480 | (assoc it sub-name 481 | rec-val))) 482 | it)) 483 | sp (:items spec)) 484 | sp))) 485 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/datomic/pull_helpers.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.pull-helpers 2 | (:require [clj-time.coerce :as timec] 3 | [datomic.api :as d] 4 | [spark.spec-tacular :refer [get-spec get-item primitive? recursive-ctor]] 5 | [spark.spec-tacular.datomic.util :refer [db-keyword]] 6 | [spark.spec-tacular.datomic.coerce :refer [coerce-datomic-entity]]) 7 | (:import (spark.spec_tacular.spec Item 8 | EnumSpec 9 | UnionSpec))) 10 | 11 | (defn datomify-spec-pattern [spec pattern] 12 | (cond 13 | (instance? UnionSpec spec) 14 | (let [rec (map #(datomify-spec-pattern (get-spec %) pattern) (:elements spec))] 15 | {:datomic-pattern (mapcat :datomic-pattern rec) 16 | :rebuild (fn [db m] (apply merge (map #(% db m) (map :rebuild rec))))}) 17 | (keyword? pattern) 18 | (when-let [{[arity sub-spec-name] :type :as item} (get-item spec pattern)] 19 | (let [kw (db-keyword spec pattern) 20 | sub-spec (get-spec sub-spec-name)] 21 | (if (and (primitive? sub-spec-name) 22 | (instance? EnumSpec sub-spec)) 23 | {:datomic-pattern [{kw [:db/ident]}] 24 | :rebuild (fn [db m] 25 | (when-let [v (get m kw)] 26 | [pattern (:db/ident v)]))} 27 | {:datomic-pattern [kw] 28 | :rebuild (fn [db m] 29 | (when-let [v (get m kw)] 30 | (let [f #(recursive-ctor (get-spec sub-spec-name) 31 | (if (:component? item) 32 | (coerce-datomic-entity %) 33 | (d/entity db (:db/id %))))] 34 | [pattern 35 | (if (primitive? sub-spec-name) 36 | (if (= sub-spec-name :calendarday) 37 | (timec/to-date-time v) 38 | v) 39 | (if (= :many arity) 40 | (mapv f v) 41 | (f v)))])))}))) 42 | (instance? Item pattern) 43 | (let [spec (get-spec (:parent-name pattern)) 44 | kw (db-keyword spec (keyword (str "_" (name (:name pattern)))))] 45 | {:datomic-pattern [kw] 46 | :rebuild (fn [db m] 47 | (when-let [v (get m kw)] 48 | (let [f #(recursive-ctor spec (d/entity db (:db/id %)))] 49 | [pattern 50 | (if (:component? pattern) 51 | (f v) 52 | (map f v))])))}) 53 | (vector? pattern) 54 | (let [rec (keep (partial datomify-spec-pattern spec) pattern) 55 | datomic-pattern (mapcat :datomic-pattern rec)] 56 | {:datomic-pattern datomic-pattern 57 | :rebuild (fn [db m] (into {} (map #(% db m) (map :rebuild rec))))}) 58 | (map? pattern) 59 | (let [rec (for [[kw-or-item sub-pattern] pattern 60 | :let [{[arity sub-spec-name] :type component? :component? :as item} 61 | (if (keyword? kw-or-item) 62 | (get-item spec kw-or-item) 63 | kw-or-item) 64 | sub-spec-name 65 | (if (keyword? kw-or-item) 66 | sub-spec-name 67 | (:parent-name kw-or-item)) 68 | {[db-kw] :datomic-pattern} 69 | (datomify-spec-pattern spec kw-or-item) 70 | {:keys [datomic-pattern rebuild]} 71 | (datomify-spec-pattern (get-spec sub-spec-name) sub-pattern)]] 72 | {:datomic-pattern [db-kw datomic-pattern] 73 | :rebuild (fn [db m] 74 | (when-let [v (get m db-kw)] 75 | [kw-or-item (cond (instance? Item kw-or-item) 76 | (if (:component? kw-or-item) 77 | (rebuild db v) 78 | (map #(rebuild db %) v)) 79 | (= arity :many) 80 | (map #(rebuild db %) v) 81 | :else (rebuild db v))]))})] 82 | {:datomic-pattern [(dissoc (into {} (map :datomic-pattern rec)) nil)] 83 | :rebuild (fn [db m] (into {} (map #(% db m) (map :rebuild rec))))}))) 84 | 85 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/datomic/query_helpers.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.query-helpers 2 | (:require [clj-time.coerce :as timec] 3 | [clojure.core.match :refer [match]] 4 | [clojure.string :refer [lower-case]] 5 | [clojure.tools.macro :as m] 6 | [datomic.api :as d] 7 | [spark.spec-tacular :refer :all] 8 | [spark.spec-tacular.datomic.util :refer [db-keyword]] 9 | [spark.spec-tacular.datomic.pull-helpers :refer [datomify-spec-pattern]]) 10 | (:import (spark.spec_tacular.spec Spec 11 | EnumSpec 12 | UnionSpec) 13 | (org.joda.time DateTime))) 14 | 15 | (def ^:const aggregate? 16 | #{'min 'max 'count 'count-distinct 'sum 'avg 'median 'variance 'stddev 'distinct 'rand 'sample}) 17 | 18 | (def ^:const protected? 19 | (conj aggregate? 'pull 'spec-pull 'instance)) 20 | 21 | (def aggregate-types 22 | {'min (fn [t] t) 23 | 'max (fn [t] t) 24 | 'count (fn [_] `t/Integer) 25 | 'count-distinct (fn [_] `t/Integer) 26 | 'sum (fn [t] t) 27 | 'avg (fn [t] `t/Num)}) 28 | 29 | ;; =================================================================================================== 30 | ;; static 31 | 32 | (defn set-type! [tenv x t] 33 | (if-let [t- (get @tenv x)] 34 | (when-not (or (= t t-) 35 | (if-let [elems (:elements (get-spec t))] 36 | (contains? elems t-))) 37 | (throw (ex-info "var has two incompatible return types" {:x x :type1 t :type2 t-}))) 38 | (do (swap! tenv assoc x t) nil))) 39 | 40 | (defn ^:no-doc expand-find-elem 41 | "Expands a single find element, returning an `:expanded-find-elem` 42 | suitable for `query` and a `:build-ret-type` that takes one 43 | argument, a type lookup function, and returns a suitable 44 | `core.typed` type." 45 | [tenv uenv find-elem] 46 | (letfn [(record-spec [spec-name] 47 | (let [spec (get-spec spec-name) 48 | %n (symbol (str "%" (inc (count @uenv)))) 49 | new (gensym (str "?" (lower-case (name spec-name))))] 50 | (set-type! tenv new spec-name) 51 | (swap! uenv assoc %n new) 52 | new))] 53 | (match find-elem 54 | (arg :guard symbol?) 55 | {:expanded-find-elem `'~arg 56 | :build-ret-type (fn [lookup] (lookup arg))} 57 | (['instance (spec-name :guard keyword?) (arg :guard symbol?)] :seq) 58 | {:expanded-find-elem (list 'list ''instance spec-name `'~arg) 59 | :build-ret-type (fn [lookup] (lookup arg))} 60 | (spec-name :guard keyword?) 61 | (let [%n (symbol (str "%" (inc (count @uenv)))) 62 | new (gensym (str "?" (lower-case (name spec-name)))) 63 | find-elem (list 'list ''instance spec-name `'~new)] 64 | (set-type! tenv new spec-name) 65 | (swap! uenv assoc %n new) 66 | {:expanded-find-elem (list 'list ''instance spec-name `'~new) 67 | :build-ret-type (fn [lookup] (lookup spec-name))}) 68 | (['pull (spec-name :guard keyword?) pattern] :seq) 69 | ,(let [new (record-spec spec-name)] 70 | {:expanded-find-elem (list 'list ''spec-pull `'~new spec-name pattern) 71 | :build-ret-type (fn [lookup] `(t/Map t/Any t/Any))}) 72 | ([(rator :guard protected?) & args] :seq) ; aggregate 73 | ,(let [arg (last args) 74 | new (if (symbol? arg) arg (record-spec arg))] 75 | {:expanded-find-elem (cons 'list (cons `'~rator (reverse (cons `'~new (rest (reverse args)))))) 76 | :build-ret-type (fn [lookup] ((get aggregate-types rator) (lookup arg)))}) 77 | ([(rator :guard #(ns-resolve *ns* %)) & args] :seq) ; custom aggregate 78 | ,(let [arg (last args) 79 | new (if (symbol? arg) arg (record-spec arg))] 80 | {:expanded-find-elem (cons 'list (cons `'~rator (reverse (cons `'~new (rest (reverse args)))))) 81 | :build-ret-type (fn [lookup] `t/Any)}) 82 | :else (throw (ex-info "bad find element, expecting symbol, keyword, or sequence" 83 | {:find-element find-elem}))))) 84 | 85 | (defn ^:no-doc expand-find-elems 86 | "Expands an entire find expression, returning a `:find-expr` 87 | suitable for `query` and a `:build-ret-type` function that takes one 88 | argument, a type lookup function, and returns a suitable 89 | `core.typed` type." 90 | [tenv uenv find-elems] 91 | (match find-elems 92 | ([elem '.] :seq) ; scalar 93 | (let [{:keys [expanded-find-elem build-ret-type]} (expand-find-elem tenv uenv elem)] 94 | {:find-expr (list 'list expanded-find-elem ''.) 95 | :build-ret-type (fn [lookup] (build-ret-type lookup))}) 96 | ([([elem '...] :seq)] :seq) ; coll 97 | (let [{:keys [expanded-find-elem build-ret-type]} (expand-find-elem tenv uenv elem)] 98 | {:find-expr (list 'list [expanded-find-elem ''...]) 99 | :build-ret-type (fn [lookup] `(t/Set ~(build-ret-type lookup)))}) 100 | ([([& (elems :guard #(not (protected? (first %))))] :seq)] :seq) ; tuple 101 | (let [rec (mapv (partial expand-find-elem tenv uenv) elems)] 102 | {:find-expr (cons 'list (list (mapv :expanded-find-elem rec))) 103 | :build-ret-type (fn [lookup] 104 | (mapv (comp #(% lookup) :build-ret-type) rec))}) 105 | ([& elems] :seq) ; relation 106 | (let [rec (mapv (partial expand-find-elem tenv uenv) elems)] 107 | {:find-expr (cons 'list (map :expanded-find-elem rec)) 108 | :build-ret-type (fn [lookup] 109 | (let [type-vec (mapv (comp #(% lookup) :build-ret-type) rec)] 110 | `(t/Set (t/HVec ~type-vec))))}) 111 | :else (throw (ex-info "expecting find specification for relation, coll, tuple, or scalar" 112 | {:syntax find-elems})))) 113 | 114 | (declare expand-spec-where-clause) 115 | 116 | (defn expand-item [tenv sub-spec-name k v] 117 | (cond 118 | (map? v) 119 | ,(let [rec' (expand-spec-where-clause tenv [sub-spec-name v])] 120 | {:map-entry [[k (ffirst rec')]] 121 | :clause rec'}) 122 | (vector? v) 123 | ,(expand-item tenv (first v) k (second v)) 124 | (and (symbol? v) (= \? (first (str v)))) 125 | ,(do (set-type! tenv v sub-spec-name) 126 | (let [t (get @tenv v)] 127 | (if (primitive? t) 128 | {:map-entry [[k `'~v]]} 129 | {:map-entry [[k `'~v]] 130 | :clause (if (instance? Spec (get-spec t)) 131 | [[`'~v :spec-tacular/spec t]] [])}))) 132 | (and (keyword? v) 133 | (not (instance? EnumSpec (get-spec sub-spec-name))) 134 | (not (= :keyword sub-spec-name))) 135 | (let [v' (gensym (str "?" (lower-case (name v))))] 136 | {:map-entry [[k `'~v']] 137 | :clause (if (instance? Spec (get-spec v)) 138 | [[`'~v' :spec-tacular/spec v]] [])}) 139 | :else 140 | {:map-entry [[k v]]})) 141 | 142 | (defn expand-map 143 | "Expands a single map in the right-hand-side of a spec clause, 144 | merging all the sub-map-entries and clauses." 145 | [tenv spec m] 146 | (->> (for [[k v] m] 147 | (if-let [{[arity sub-spec-name] :type} (get-item spec k)] 148 | (expand-item tenv sub-spec-name k v) 149 | (throw (ex-info "keyword not in spec" {:k k :spec spec})))) 150 | (apply merge-with concat))) 151 | 152 | (defn expand-spec-map-clause 153 | "Expands a spec map clause `[lhs rhs]`, where `lhs` is a symbol and 154 | `rhs` is a map." 155 | [tenv spec lhs rhs] 156 | (cond 157 | (instance? Spec spec) 158 | (let [rec (expand-map tenv spec rhs)] 159 | (vec (concat [[`'~lhs (into {:spec-tacular/spec (:name spec)} (:map-entry rec))]] 160 | (:clause rec)))) 161 | (instance? UnionSpec spec) 162 | (let [rec (->> (:elements spec) 163 | (mapv (fn [spec-name] 164 | (try {:syntax {spec-name (expand-spec-map-clause tenv (get-spec spec-name) lhs rhs)}} 165 | (catch clojure.lang.ExceptionInfo e {:error {spec-name e}})))) 166 | (apply merge-with merge))] 167 | (when (empty? (:syntax rec)) 168 | (throw (ex-info "does not conform to any possible unioned spec" 169 | {:syntax rhs :errors (:errors rec)}))) 170 | (doseq [[spec-name e] (:error rec)] 171 | (case (.getMessage e) "var has two incompatible return types" (throw e) nil)) 172 | [(cons 'list (cons ''or (map #(cons 'list (cons ''and %)) (vals (:syntax rec)))))]))) 173 | 174 | (defn expand-spec-where-clause 175 | "Expands a spec where clause, where `lhs` can still be either a 176 | symbol or a keyword. Passes off to `expand-spec-map-clause`." 177 | [tenv clause] 178 | (match clause 179 | [(sym :guard symbol?) (rhs :guard map?)] ; no spec name 180 | (let [spec-name (get @tenv sym) 181 | spec (or (get-spec spec-name) (get-spec rhs))] 182 | (when-not spec 183 | (throw (ex-info "could not infer type" {:sym sym :syntax clause}))) 184 | (expand-spec-map-clause tenv spec sym rhs)) 185 | [(spec-name :guard keyword?) (rhs :guard map?)] ; with spec-name on lhs 186 | (let [spec (get-spec spec-name) 187 | x-gs (gensym (str "?" (lower-case (name spec-name))))] 188 | (expand-spec-map-clause tenv spec x-gs rhs)) 189 | [(lhs :guard symbol?) [(spec-name :guard keyword?) (rhs :guard map?)]] 190 | (do (when-not (get-spec spec-name) 191 | (throw (ex-info "where clause matches spec-tacular syntax but keyword is not a spec-name" 192 | {:keyword spec-name :clause clause}))) 193 | (set-type! tenv lhs spec-name) 194 | (expand-spec-where-clause tenv [lhs rhs])) 195 | :else (throw (ex-info "invalid where clause" {:syntax clause})))) 196 | 197 | (defn wrap-variable [x] 198 | (if (and (symbol? x) (= \? (first (str x)))) 199 | `'~x x)) 200 | 201 | (defn expand-where-clause 202 | "Expands any where clause. Leaves most as is, except for spec 203 | where-clauses, which are handled by `expand-spec-where-clause`." 204 | [tenv clause] 205 | (match clause 206 | [lhs (rhs :guard map?)] 207 | (expand-spec-where-clause tenv clause) 208 | [lhs [(spec-name :guard keyword?) (rhs :guard map?)]] 209 | (expand-spec-where-clause tenv clause) 210 | ([(rator :guard '#{not datomic-or datomic-and}) & clauses] :seq) 211 | (let [clauses' (mapcat (partial expand-where-clause tenv) clauses)] 212 | [(cons 'list (cons (case rator datomic-or ''or datomic-and ''and `'~rator) clauses'))]) 213 | ([(rator :guard '#{not-join or-join}) ([& syms] :seq) & clauses] :seq) 214 | (let [clauses' (mapcat (partial expand-where-clause tenv) clauses)] 215 | [(cons 'list (cons `'~rator (cons `'~syms clauses')))]) 216 | ([([rator & args] :seq) rhs] :seq) ; fn-expr 217 | [[(apply list 'list `'~rator (mapv wrap-variable args)) (wrap-variable rhs)]] 218 | ([([rator & args] :seq)] :seq) ; pred-expr 219 | [[(apply list 'list `'~rator (mapv wrap-variable args))]] 220 | ([(rator :guard symbol?) & (args :guard #(every? (complement seq?) %))] :seq) ; data pattern 221 | [(vec (cons `'~rator (map wrap-variable args)))] 222 | :else (throw (ex-info "invalid where clause" {:syntax clause})))) 223 | 224 | ;; (q :find find-expr+ :in clojure-expr :where clause+) 225 | ;; find-expr = ident 226 | ;; ident = spec-name 227 | ;; | datomic-variable 228 | ;; | [datomic-variable spec-name]; 229 | ; clause = [ident map] 230 | ;; map = % | %n | spec-name 231 | ;; | {:kw (clause | map | ident | value),+} 232 | (defn parse-query [stx] 233 | (let [keyword? #{:find :in :where} 234 | partitions (partition-by (fn [stx] (keyword? stx)) stx)] 235 | (match partitions ;; ((:find) (1 2 ....) (:in) (3) (:where) (4 5 ....)) 236 | ([([:find] :seq) f ([:in] :seq) in ([:where] :seq) wc] :seq) 237 | (let [tenv (atom {}) 238 | uenv (atom {}) 239 | {:keys [find-expr build-ret-type]} (expand-find-elems tenv uenv f) 240 | ;; after uenv populated 241 | bindings (apply concat '[% %1] '[or datomic-or] '[and datomic-and] (vec @uenv)) 242 | do-expr (m/mexpand `(m/symbol-macrolet ~bindings ~wc)) ; expands with a `do` 243 | clauses (second do-expr) 244 | where-expr (mapcat (partial expand-where-clause tenv) clauses) 245 | ;; after tenv populated 246 | lookup (fn [x] (or (some-> (if (symbol? x) (get @tenv x) x) get-type :type-symbol) `t/Any)) 247 | query-ret-type (build-ret-type lookup)] 248 | {:find-expr find-expr 249 | :db-expr (first in) 250 | :in-expr (cons 'list (rest in)) 251 | :where-expr (cons 'list where-expr) 252 | :query-ret-type query-ret-type}) 253 | :else 254 | (throw (ex-info "expecting keywords :find, :in, and :where followed by arguments" 255 | {:syntax partitions}))))) 256 | 257 | ;; =================================================================================================== 258 | ;; dynamic 259 | 260 | ;; From http://docs.datomic.com/query.html 261 | ;; where-clauses = ':where' clause+ 262 | ;; clause = (not-clause | not-join-clause | or-clause | or-join-clause | expression-clause) 263 | ;; not-clause = [ src-var? 'not' clause+ ] 264 | ;; not-join-clause = [ src-var? 'not-join' [variable+] clause+ ] 265 | ;; or-clause = [ src-var? 'or' (clause | and-clause)+] 266 | ;; or-join-clause = [ src-var? 'or-join' rule-vars (clause | and-clause)+ ] 267 | ;; and-clause = [ 'and' clause+ ] 268 | ;; expression-clause = (data-pattern | pred-expr | fn-expr | rule-expr) 269 | ;; data-pattern = [ src-var? (variable | constant | '_')+ ] 270 | ;; pred-expr = [ [pred fn-arg+] ] 271 | ;; fn-expr = [ [fn fn-arg+] binding ] 272 | ;; binding = (bind-scalar | bind-tuple | bind-coll | bind-rel) 273 | ;; bind-scalar = variable 274 | ;; bind-tuple = [ (variable | '_')+] 275 | ;; bind-coll = [variable '...'] 276 | ;; bind-rel = [ [(variable | '_')+] ] 277 | 278 | (defn combine-where-clauses [& clauses] 279 | (if (not (empty? (rest clauses))) 280 | (cons 'and (distinct (mapcat #(case (first %) and (rest %) [%]) clauses))) 281 | (first clauses))) 282 | 283 | (defn or-clause [& clauses] 284 | (if (empty? (rest clauses)) (first clauses) (cons 'or clauses))) 285 | 286 | (defn datomify-spec-where-clause [spec-name lhs rhs] 287 | (let [spec (get-spec spec-name)] 288 | (cond 289 | (instance? Spec spec) 290 | (apply combine-where-clauses 291 | [lhs :spec-tacular/spec spec-name] 292 | (for [[k v] (dissoc rhs :spec-tacular/spec) 293 | :let [{[arity sub-spec-name] :type :as item} (get-item spec k) 294 | db-kw (db-keyword spec k)]] 295 | (cond (nil? v) 296 | (throw (ex-info "can't have nil args in clause" 297 | {:syntax rhs})) 298 | (symbol? v) 299 | [lhs db-kw v] 300 | (and (not (primitive? sub-spec-name)) 301 | (= (:name (get-spec v) sub-spec-name))) 302 | (let [sub-spec (get-spec sub-spec-name)] 303 | (if-let [eid (get-in v [:db-ref :eid])] 304 | [lhs db-kw eid] 305 | (when-let [unique-item (some #(when (and (:unique? %) (:identity? %)) %) 306 | (:items sub-spec))] 307 | (when-some [v' ((:name unique-item) v)] 308 | (let [gs (gensym '?tmp)] 309 | (combine-where-clauses 310 | [lhs db-kw gs] 311 | [gs (db-keyword sub-spec (:name unique-item)) v'])))))) 312 | (and (= sub-spec-name :calendarday) 313 | (instance? DateTime v)) 314 | [lhs db-kw (timec/to-date v)] 315 | :else 316 | [lhs db-kw v]))) 317 | (instance? UnionSpec spec) 318 | (apply or-clause 319 | (for [sub-spec-name (:elements spec)] 320 | (datomify-spec-where-clause sub-spec-name lhs rhs)))))) 321 | 322 | (defn datomify-where-clause [clause] 323 | (match clause 324 | ([(rator :guard '#{not or and}) & clauses] :seq) 325 | (let [clauses (map datomify-where-clause clauses)] 326 | (case rator 327 | (or) (apply or-clause clauses) 328 | (and) (apply combine-where-clauses clauses) 329 | (not) (list 'not (apply combine-where-clauses clauses)))) 330 | ([(rator :guard '#{not-join or-join}) ([& syms] :seq) & clauses] :seq) 331 | (let [body (rest (apply combine-where-clauses (map datomify-where-clause clauses)))] 332 | (cons rator (cons syms body))) 333 | ([(lhs :guard seq?) rhs] :seq) ;; fn-expr 334 | clause 335 | ([(lhs :guard symbol?) {:spec-tacular/spec spec-name}] :seq) ;; spec-tacular rhs 336 | (datomify-spec-where-clause spec-name lhs (second clause)) 337 | ([([(rator :guard symbol?) & rands] :seq)] :seq) ;; predicate expression 338 | clause 339 | ([& (args :guard #(every? (complement seq?) %))] :seq) ;; data pattern 340 | clause 341 | :else (throw (ex-info "invalid where clause" {:clause clause})))) 342 | 343 | (defn datomify-find-elem [find-elem] 344 | (let [identity-rebuild (fn [db result] result)] 345 | (match find-elem 346 | (['spec-pull (arg :guard symbol?) spec pattern] :seq) 347 | (let [spec (get-spec spec) 348 | {:keys [datomic-pattern rebuild]} (datomify-spec-pattern spec pattern)] 349 | {:datomic-find-elem (list 'pull arg datomic-pattern) 350 | :rebuild rebuild}) 351 | (['instance spec-name (arg :guard symbol?)] :seq) 352 | {:datomic-find-elem arg 353 | :rebuild 354 | (fn [db result] 355 | (let [spec (get-spec spec-name) 356 | err #(throw (ex-info "unexpected type returned from Datomic" 357 | {:actual-type (type result) 358 | :expected-type spec-name 359 | :query-result result}))] 360 | (if (and (primitive? spec-name) 361 | (not (instance? EnumSpec spec))) 362 | (if (= spec-name :calendarday) 363 | (if (instance? java.util.Date result) 364 | (timec/to-date-time result) (err)) 365 | (if (instance? (get-spec-class spec-name) result) 366 | result (err))) 367 | (if (instance? java.lang.Long result) 368 | (recursive-ctor spec-name (d/entity db result)) (err)))))} 369 | ([(rator :guard protected?) & args] :seq) 370 | {:datomic-find-elem (cons rator args) 371 | :rebuild identity-rebuild} 372 | ([(rator :guard #(ns-resolve *ns* %)) & args] :seq) ; custom aggregate 373 | {:datomic-find-elem (cons rator args) 374 | :rebuild identity-rebuild} 375 | (arg :guard symbol?) 376 | {:datomic-find-elem arg 377 | :rebuild identity-rebuild} 378 | :else (throw (ex-info "bad find element, expecting symbol, keyword, or sequence" 379 | {:find-element find-elem}))))) 380 | 381 | (defn datomify-find-elems [find-elems] 382 | (match find-elems 383 | ([elem '.] :seq) ; scalar 384 | (let [{:keys [datomic-find-elem rebuild]} (datomify-find-elem elem)] 385 | {:datomic-find (list datomic-find-elem '.) 386 | :rebuild (fn [db result] (rebuild db result))}) 387 | ([([elem '...] :seq)] :seq) ; coll 388 | (let [{:keys [datomic-find-elem rebuild]} (datomify-find-elem elem)] 389 | {:datomic-find (list [datomic-find-elem '...]) 390 | :rebuild (fn [db result] (set (mapv rebuild (repeat db) result)))}) 391 | ([([& (elems :guard #(not (protected? (first %))))] :seq)] :seq) ; tuple 392 | (let [rec (map datomify-find-elem elems)] 393 | {:datomic-find (list (mapv :datomic-find-elem rec)) 394 | :rebuild (fn [db results] (mapv #(%1 db %2) (map :rebuild rec) results))}) 395 | ([& elems] :seq) ; relation 396 | (let [rec (map datomify-find-elem elems)] 397 | {:datomic-find (map :datomic-find-elem rec) 398 | :rebuild (fn [db results] 399 | (set (mapv (fn [results] (mapv #(%1 db %2) (map :rebuild rec) results)) results)))}) 400 | :else (throw (ex-info "expecting find specification for relation, coll, tuple, or scalar" 401 | {:syntax find-elems})))) 402 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/datomic/util.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.util 2 | {:doc "Utility functions for spark.spec-tacular.datomic" 3 | :core.typed {:collect-only true}} 4 | (:require [clojure.core.typed :as t] 5 | [clojure.string :refer [lower-case]] 6 | ;; for types 7 | [spark.spec-tacular :as spec])) 8 | 9 | (t/ann ^:no-check db-keyword [SpecT t/Keyword -> t/Keyword]) 10 | (defn db-keyword 11 | [spec a] 12 | (let [dns (-> spec :name name lower-case) 13 | make-keyword #(keyword dns %)] 14 | (cond 15 | (instance? clojure.lang.Named a) 16 | ,(make-keyword (name a)) 17 | (contains? a :name) 18 | ,(make-keyword (name (:name a))) 19 | :else (throw (ex-info "cannot make db-keyword" {:spec spec :attr a}))))) 20 | 21 | (t/ann ^:no-check datomic-ns [SpecT -> t/Str]) 22 | (defn datomic-ns 23 | "Returns a string representation of the db-normalized namespace for the given spec." 24 | [spec] 25 | (some-> spec :name name lower-case)) 26 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/generators.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.generators 2 | "Provides generators to be used in conjunction 3 | with [clojure.test.check.generators](https://github.com/clojure/test.check)" 4 | (:refer-clojure :exclude [assoc!]) 5 | (:use spark.spec-tacular 6 | [spark.spec-tacular.datomic :exclude [db]]) 7 | (:require [datomic.api :as db] 8 | [spark.spec-tacular.schema :as schema] 9 | [clj-time.core :as time] 10 | [clj-time.coerce :as timec] 11 | [clojure.test.check :as tc] 12 | [clojure.test.check.properties :as prop] 13 | [clojure.test.check.generators :as gen] 14 | [clojure.test.check.clojure-test :as ct])) 15 | 16 | (def ^{:doc "map of generators for primitive specs, by keyword name." 17 | :private true} 18 | prim-gens 19 | {:keyword gen/keyword 20 | :string gen/string-ascii 21 | :boolean gen/boolean 22 | :long gen/int 23 | :bigint (gen/fmap #(java.math.BigInteger. %) gen/int) 24 | :float (gen/fmap #(float (/ % 100.0)) gen/int) 25 | :double gen/double 26 | :bigdec (gen/fmap #(/ (java.math.BigDecimal. %) 100.0M) gen/int) 27 | :instant (gen/fmap #(java.util.Date. %) gen/int) 28 | :uuid (gen/fmap #(java.util.UUID/nameUUIDFromBytes %) 29 | (gen/resize 10 gen/bytes)) 30 | :uri (gen/fmap #(java.net.URI. %) gen/string-alpha-numeric) 31 | :bytes gen/bytes 32 | :ref gen/simple-type-printable 33 | :calendarday 34 | (gen/fmap (fn [date] 35 | (clojure.core/let [dt (timec/from-date date)] 36 | (time/date-time (time/year dt) (time/month dt) (time/day dt)))) 37 | (gen/fmap #(java.util.Date. %) gen/int)) 38 | }) 39 | 40 | (defmulti instance-generator 41 | "Returns a generator for the given spec. Optional second argument 42 | can be used to override generators for the items in the spec, and 43 | should be a map from field names to generators." 44 | (fn [spec & rest] spec)) 45 | 46 | (defn- item-gen 47 | [{iname :name [cardinality type-key] :type required :required? unique? :unique?} 48 | overrides] 49 | (let [maybe-optionize (if required identity #(gen/one-of [(gen/return nil) %])) 50 | maybe-unique (if (and unique? (= type-key :string)) 51 | #(gen/bind % (fn [s] (gen/return (str (gensym) s)))) 52 | identity)] 53 | [iname (-> (or (get overrides iname) 54 | (let [generator (instance-generator type-key)] 55 | (assert generator (str "missing definition of sub-generator: " 56 | type-key)) 57 | (-> (case cardinality 58 | :one generator 59 | :many (gen/bind (gen/vector generator) 60 | ;; distinct works for primitives but 61 | ;; not for spec instances for some reason 62 | (fn [coll] (gen/return (distinct coll))))) 63 | maybe-unique 64 | maybe-optionize))))])) 65 | 66 | (defn- spec-gen [spec overrides & [pre]] 67 | (cond 68 | (:elements spec) 69 | ,(gen/one-of (map instance-generator (:elements spec))) 70 | (:items spec) 71 | ,(gen/bind (gen/frequency [[8 (gen/return true)] [2 (gen/return false)]]) 72 | (fn [use-pre?] 73 | (if-let [insts (and use-pre? pre (get @pre (:name spec)))] 74 | (gen/return (rand-nth insts)) 75 | (let [kvs (->> (:items spec) 76 | (filter (fn [item] 77 | (or (not (= (get-spec (second (:type item))) spec)) 78 | (not use-pre?)) ;; hijack use-pre? to stop infinite recursion 79 | )) 80 | (map #(item-gen % overrides))) 81 | mapgen (gen/fmap #(->> % (filter second) (into {})) 82 | (apply gen/hash-map (apply concat kvs))) 83 | factory (get-ctor (:name spec))] 84 | (gen/bind (gen/fmap factory mapgen) 85 | (fn [sp] 86 | (do (when (and pre sp) 87 | (swap! pre update-in [(:name spec)] #(conj % sp))) 88 | (gen/return sp)))))))) 89 | (:values spec) 90 | (gen/one-of (map #(gen/return %) (:values spec))))) 91 | 92 | (defmethod instance-generator :default 93 | [spec-name & [overrides]] 94 | (if (and (primitive? spec-name) 95 | (not (:values (get-spec spec-name)))) 96 | (get prim-gens spec-name) 97 | (spec-gen (get-spec spec-name) overrides))) 98 | 99 | (defn- spec-subset 100 | "generates a map from a generator but with just a subset of the keys. 101 | could be missing required fields" 102 | [sp-gen] 103 | (gen/bind sp-gen 104 | (fn [sp] 105 | (let [spec (get-spec sp) 106 | subset-gen (gen/vector gen/boolean (count (:items spec)) (count (:items spec)))] 107 | (gen/bind subset-gen 108 | (fn [subset] 109 | (let [keep (->> (map vector (:items spec) subset) 110 | (filter second) 111 | (map (comp :name first)))] 112 | (gen/return (into {} (map (fn [k] [k (get sp k)]) keep)))))))))) 113 | 114 | (defn- spec-children 115 | "Returns the set of spec names that need to be defined prior to this one. 116 | CAUTION this involves manually breaking any cycles in the spec dependency graph." 117 | [spec-key] 118 | (let [spec (get-spec spec-key)] 119 | (or (:elements spec) 120 | (->> (:items spec) 121 | (filter (fn [{iname :name [cardinality sub-sp-nm] :type}] true)) 122 | (map #(-> % :type second)) 123 | (set))))) 124 | 125 | (defn- spec-dependencies 126 | "recursive dependencies for a collection of spec keys 127 | (fixpoint, including originally supplied keys). 128 | Returns a set." 129 | [spec-keys] 130 | (let [next-set (apply clojure.set/union spec-keys (map spec-children spec-keys))] 131 | (if (= spec-keys next-set) next-set (recur next-set)))) 132 | 133 | (defn- mk-spec-generators 134 | "returns a map of keys->[env -> generator], including generators for all required deps. 135 | Implementations in prim-gen-map (key->[env -> generator]) override auto-building 136 | of compound gens, but also provide gens for terminals like strings etc." 137 | [spec-key-set prim-gen-map & [pre]] 138 | (let [deps (spec-dependencies spec-key-set)] 139 | (into {} (map (fn [d] 140 | [d (if (contains? prim-gen-map d) 141 | (get prim-gen-map d) 142 | #(spec-gen (get-spec d) % pre))]) 143 | deps)))) 144 | 145 | (defn ^:no-doc mk-spec-generator 146 | "Generates a default generator for the given key. 147 | Uses prim-gens to implement generators for primitive types. 148 | ex: (last (gen/sample (mk-spec-generator :Contact) 1))" 149 | [spec-key & [pre]] 150 | (let [spec-gen-env (mk-spec-generators #{spec-key} prim-gens pre)] 151 | ((get spec-gen-env spec-key) spec-gen-env))) 152 | 153 | (defn update-generator 154 | "Returns a spec instance \"subset\" (intended to be smaller than 155 | generating an instance of `spec` with [[instance-generator]]) 156 | suitable to use as an argument to [[assoc!]]." 157 | [spec] 158 | (if-let [spec-key (:name (get-spec spec))] 159 | (let [sp-gen (mk-spec-generator spec-key)] 160 | (spec-subset sp-gen)) 161 | (throw (ex-info "Expecting spec object or name of spec" {:actual spec})))) 162 | 163 | (defn ^:no-doc graph-generator [spec] 164 | (let [pre (atom {}) 165 | sp-gen (mk-spec-generator (:name spec) pre)] 166 | (gen/bind (gen/such-that #(> (count %) 3) (gen/not-empty (gen/vector sp-gen)) 50) 167 | #(gen/return {:expected %})))) 168 | 169 | (defn check-create! 170 | "Checks that `original` can be created on the database." 171 | {:added "0.6.0"} 172 | [conn-ctx original] 173 | (let [actual (create! conn-ctx original)] 174 | (if (refless= actual original) actual 175 | (throw (ex-info "creation mismatch: output doesn't reflect input" 176 | {:actual actual :expected original}))))) 177 | 178 | (defn check-update! 179 | "Checks that `original` can be updated with `updates`, and the 180 | result should be a shallow merge of `original` into `updates`. 181 | 182 | Generate as suitable update map with [[update-generator]]." 183 | {:added "0.6.0"} 184 | [conn-ctx original updates] 185 | (let [expected (merge original updates) 186 | actual (update! conn-ctx original updates)] 187 | (if (refless= expected actual) actual 188 | (throw (ex-info "update mismatch, output is not equivalent to input" 189 | {:original original :updates updates :actual actual}))))) 190 | 191 | (defn prop-creation-update 192 | "Defines a property that tests whether instances of a given spec 193 | name can be created, updated, and sent to and from the database." 194 | {:added "0.6.0"} 195 | [conn-ctx-thunk spec-key] 196 | (let [spec (get-spec spec-key) 197 | fields (map :name (:items spec))] 198 | (prop/for-all [{:keys [conn-ctx original updates]} 199 | (gen/bind (instance-generator spec-key) 200 | (fn [sp] 201 | (gen/bind (update-generator (get-spec sp)) 202 | (fn [updates] 203 | (gen/return {:conn-ctx (conn-ctx-thunk) 204 | :original sp 205 | :updates updates})))))] 206 | (and (every? #(check-component! spec % (get original %)) fields) 207 | (when-let [created (check-create! conn-ctx original)] 208 | (or (= created :skip) (check-update! conn-ctx created updates))))))) 209 | 210 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/grammar.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.grammar 2 | (:use [spark.spec-tacular.spec]) 3 | (:require [clojure.core.match :refer [match]]) 4 | (:refer-clojure :exclude [name])) 5 | 6 | (declare parse-spec parse-item parse-type parse-opts) 7 | 8 | ;; ----------------------------------------------------------------------------- 9 | ;; spec 10 | 11 | (defn parse-spec [stx & [loc]] 12 | (let [loc (or loc (merge {:namespace (str *ns*)} (meta stx)))] 13 | (letfn [(build [name docstring items] 14 | (let [name (keyword name) 15 | items (mapcat #(parse-item % loc) items) 16 | attrs (cond-> {:name name 17 | :items items 18 | :syntax (cons 'defspec stx)} 19 | docstring (assoc :doc docstring))] 20 | (map->Spec attrs)))] 21 | (match stx 22 | ([name (docstring :guard string?) & items] :seq) 23 | ,(build name docstring items) 24 | ([name & items] :seq) 25 | ,(build name nil items) 26 | :else (throw (ex-info "expecting name followed by sequence of items" 27 | (merge loc {:syntax stx}))))))) 28 | 29 | (defn parse-item [stx & [loc]] 30 | (match stx 31 | ([:link & items*] :seq) 32 | ,(mapcat parse-item (map #(conj % :link) items*)) 33 | 34 | ([:component & items*] :seq) 35 | ,(mapcat parse-item (map #(conj % :component) items*)) 36 | 37 | (([name card t & opts] :seq) :guard vector?) 38 | ,(let [cardinality (case card (:is-a :is-an) :one (:is-many) :many) 39 | item-info (->> (parse-opts opts loc) 40 | (#(if (contains? type-map t) (dissoc % :link?) %))) 41 | item-name (keyword name)] 42 | (when (and (:component? item-info) (:link? item-info)) 43 | (throw (ex-info "can't have a component link" 44 | (merge loc {:syntax stx})))) 45 | (when-not (keyword? t) 46 | (throw (ex-info (str "expecting keyword type, got " (type t)) 47 | (merge loc {:syntax stx})))) 48 | [(map->Item (merge {:name item-name :type [cardinality t]} item-info))]) 49 | 50 | :else (throw (ex-info "expecting item [item-name cardinality type opts*] or (:link item*)" 51 | (merge loc {:syntax stx}))))) 52 | 53 | (defn parse-opts [stx & [loc]] 54 | (let [k (fn [m rest] (merge m (parse-opts rest)))] 55 | (match stx 56 | (_ :guard empty?) {} 57 | ([:precondition func & rest] :seq) (k {:precondition func} rest) 58 | ([:required & rest] :seq) (k {:required? true} rest) 59 | ([:identity & rest] :seq) (k {:identity? true} rest) 60 | ([:unique & rest] :seq) (k {:unique? true} rest) 61 | ([:link & rest] :seq) (k {:link? true} rest) 62 | ([:default-value v & rest] :seq) (k {:default-value v} rest) 63 | ([:component & rest] :seq) (k {:component? true} rest) 64 | ([:doc doc-string & rest] :seq) (k {:doc doc-string} rest) 65 | :else (throw (ex-info "invalid options" (merge loc {:syntax stx})))))) 66 | 67 | ;; ----------------------------------------------------------------------------- 68 | ;; union 69 | 70 | (defn parse-union [stx & [loc]] 71 | (let [loc (or loc (merge {:namespace (str *ns*)} (meta stx)))] 72 | (letfn [(build [name docstring specs] 73 | (let [attrs (cond-> {:name (keyword name) 74 | :elements (into #{} specs)} 75 | docstring 76 | (assoc :doc docstring))] 77 | (map->UnionSpec attrs)))] 78 | (match stx 79 | ([name (docstring :guard string?) & specs] :seq) 80 | ,(build name docstring specs) 81 | ([name & specs] :seq) 82 | ,(build name nil specs) 83 | :else (throw (ex-info "expecting name followed by sequence of specs" 84 | (merge loc {:syntax stx}))))))) 85 | 86 | ;; ----------------------------------------------------------------------------- 87 | ;; enum 88 | 89 | (defn parse-enum [stx & [loc]] 90 | (let [loc (or loc (merge {:namespace (str *ns*)} (meta stx)))] 91 | (letfn [(build [name docstring values] 92 | (do (when-not (symbol? name) 93 | (throw (ex-info (str "enumeration name must be a symbol, given " (type name)) 94 | (merge loc {:syntax stx})))) 95 | (when-not (every? symbol? values) 96 | (throw (ex-info "some enumeration values are not symbols" 97 | (merge loc {:syntax stx :problems (filter (complement symbol?) values)})))) 98 | (when (empty? values) 99 | (throw (ex-info "enumeration can't be empty" 100 | (merge loc {:syntax stx})))) 101 | (let [ename (keyword name) 102 | vals (map #(keyword (str name) (str %)) values) 103 | attrs (cond-> {:name ename 104 | :values (into #{} vals)} 105 | docstring 106 | (assoc :doc docstring))] 107 | (map->EnumSpec attrs))))] 108 | (match stx 109 | ([name (docstring :guard string?) & values] :seq) 110 | ,(build name docstring values) 111 | ([name & values] :seq) 112 | ,(build name nil values) 113 | :else (throw (ex-info "expecting name followed by arbitrary number of symbols" 114 | (merge loc {:syntax stx}))))))) 115 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/restify.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.restify 2 | "Totally unsupported and depricated, but this namespace would be a 3 | good start for web serialization." 4 | (:require [datomic.api :as d] 5 | [clojure.walk :as walk] 6 | [spark.spec-tacular.datomic :as sd] 7 | [spark.spec-tacular :as sp] 8 | [clojure-csv.core :as csv] 9 | [clojure.string :as str :refer [lower-case]]) 10 | (:import java.lang.Throwable)) 11 | 12 | ;; ----------------------------------------------------------------------------- 13 | ;; inspect-spec 14 | 15 | (defn ^:no-doc inspect-spec 16 | "Produces a json-friendly nested-map representation of a spec. 17 | Nesting depth is bounded by the mask." 18 | [spec-name mask & [resource-prefix-str schema-prefix-str]] 19 | (let [spec (sp/get-spec spec-name) 20 | spec-type (if (:elements spec) 21 | :union 22 | (if (sp/primitive? spec-name) 23 | :primitive 24 | :record)) 25 | resource-kv (when (and resource-prefix-str (= :record spec-type)) 26 | {:resource-url (str resource-prefix-str "/" 27 | (lower-case (name spec-name)))}) 28 | inspect-kv (when (and schema-prefix-str (#{:record :union} spec-type)) 29 | {:schema-url (str schema-prefix-str "/" 30 | (lower-case (name spec-name)))})] 31 | (when mask 32 | (merge 33 | {:spec-name spec-name 34 | :spec-type spec-type} 35 | inspect-kv 36 | resource-kv 37 | (if (map? mask) 38 | (if (= :union spec-type) 39 | {:expanded true 40 | :union-elements (->> (:elements spec) 41 | (map #(inspect-spec % (get mask %) resource-prefix-str schema-prefix-str)) 42 | (filter some?))} 43 | (let [items 44 | , (for [{iname :name [cardinality sub-sp-nm] :type :as item} (:items spec) 45 | :when (iname mask)] 46 | {iname {:many (= cardinality :many) 47 | :required (if (:required? item) true false) 48 | ;; :identity? (:identity? item) ; not meaningful for front-end? 49 | ;; :unique? (:unique? item) 50 | ;; :optional (:optional item) 51 | :spec (inspect-spec sub-sp-nm (iname mask) resource-prefix-str schema-prefix-str)}})] 52 | {:expanded true 53 | :items (or (reduce merge items) [])})) 54 | (if (= :primitive spec-type) 55 | {:expanded true} 56 | {:expanded false})))))) 57 | 58 | ;; ----------------------------------------------------------------------------- 59 | 60 | (defn explicitly-tag 61 | "deep-walks a sp object adding explicit :spec-tacular/spec 62 | spec name tags to the object and all its child items." 63 | [sp] 64 | (let [spec (sp/get-spec sp) 65 | {recs :rec non-recs :non-rec} (group-by sp/recursiveness (:items spec)) 66 | sub-kvs (->> recs 67 | (map (fn [{[arity sub-spec-name] :type :as item}] 68 | (let [sub-sp (get sp (:name item))] 69 | (cond 70 | (and (= arity :one) (some? sub-sp)) ; only build non-nil sub-sps 71 | , [(:name item) (explicitly-tag sub-sp)] 72 | (and (= arity :many) (some? sub-sp)) 73 | , [(:name item) (map #(explicitly-tag %) sub-sp)] 74 | :else nil)))) 75 | (filter some?))] 76 | (into (merge (into {} sp) {:spec-tacular/spec (:name spec)}) sub-kvs))) 77 | 78 | (defn to-json-friendly 79 | "converts sp object to json representation with explicit spec tags 80 | with the un-namespaced :spec-tacular-spec keyword" 81 | [sp] 82 | (->> (explicitly-tag sp) 83 | (walk/postwalk 84 | (fn [o] (if (and (map? o) (contains? o :spec-tacular/spec)) 85 | (-> o 86 | (assoc :spec-tacular-spec (get o :spec-tacular/spec)) 87 | (dissoc :spec-tacular/spec)) 88 | o))))) 89 | 90 | (defn from-json-friendly 91 | "converts from the json converted rep to the given spark record re-namespacing the 92 | spec tag :spec-tacular-spec to :spec-tacular/spec. 93 | Also converts the spec tag back into a keyword, (json would have stringed it)" 94 | [spec-name jf] 95 | (->> jf 96 | (walk/postwalk 97 | (fn [o] 98 | (if (and (map? o) (get o :spec-tacular-spec)) 99 | (-> o 100 | (assoc :spec-tacular/spec (keyword (get o :spec-tacular-spec))) 101 | (dissoc :spec-tacular-spec)) 102 | o))) 103 | (sp/recursive-ctor spec-name))) 104 | 105 | (defn csv-extract-fields 106 | "returns list of pairs of colName and colValues, where colName is a list of 'item' names representing the nesting structure. 107 | eg ([(:phones) 'List of 0 phones'] [(:first-name) nil] [(:some-nested-thing :first-name) nil])" 108 | [spec-name sp] 109 | (let [spec (sp/get-spec spec-name)] 110 | (if (:elements spec) 111 | [[(list spec-name) (:name (sp/get-spec sp))]] 112 | (let [{recs :rec non-recs :non-rec} (group-by sp/recursiveness (:items spec)) 113 | rec-cols (->> recs 114 | (map (fn [{[arity sub-spec-name] :type :as item}] 115 | (let [sub-sp (get sp (:name item))] 116 | (cond 117 | (= arity :one) 118 | ;TODO: extract this and share w/ :many-arity case? 119 | , (->> (csv-extract-fields sub-spec-name sub-sp) ; :grandparentAttribute -> [[[:parentAttribute :subAttribute] col-value],...] 120 | (map (fn [[colName colVal]] 121 | [(cons (:name item) colName) colVal]))) 122 | (= arity :many) 123 | , (let [key-name (name (:name item)) 124 | ;for arrays, we want to expand columns for the FIRST element in the array 125 | ;TODO: extract this and share w/ :one-arity case? 126 | sub-fields (->> (csv-extract-fields sub-spec-name (first sub-sp)) 127 | (map (fn [[colName colVal]] 128 | [(cons (str key-name "[0]") colName) colVal])))] 129 | (concat [[(list (str key-name "[].count")) (count sub-sp)]] sub-fields)) 130 | :else nil)))) 131 | (filter some?) 132 | (apply concat)) 133 | non-rec-cols (->> non-recs 134 | (map (fn [item] 135 | [(list (:name item)) (get sp (:name item))])))] 136 | (concat non-rec-cols rec-cols))))) 137 | 138 | (defn csv-build 139 | "returns a comma delimited string listing all instances of a given spec. 140 | usage like (build-csv :User (sd/get-all-of-type (db/get-db) (sp/get-spec :User)))" 141 | [sp-name sp-list] 142 | (let [col-names (->> (csv-extract-fields sp-name nil) 143 | (map first) 144 | (map #(clojure.string/join "." (map name %)))) 145 | vals (map (fn [sp] 146 | (->> (csv-extract-fields sp-name sp) 147 | (map (comp str second)))) 148 | sp-list)] 149 | (csv/write-csv (cons col-names vals)))) 150 | 151 | (defn- mk-coll-get-response-json 152 | "Returns JSON describing the collection, in a ring-response. If ?simple=true is passed as a query param, then the items 153 | will go through a transformation function which returns {:value value :display \"display\"} representation" 154 | [req eids sp-list simple-repr-fn] 155 | (let [tagged (map to-json-friendly sp-list) 156 | simple-mode (and (fn? simple-repr-fn) 157 | (= (-> req :query-params :simple) "true")) 158 | result (if simple-mode (map simple-repr-fn tagged) tagged)] 159 | result)) 160 | 161 | (defn- ent-of-type? 162 | "Helper; Given a datomic entity (from d/entity) and a spec, 163 | returns true if the entity is of that spec's type" 164 | [ent spec] 165 | (and (some? ent) 166 | (not (empty? ent)) 167 | (= (:name spec) (:spec-tacular/spec ent)))) 168 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/schema.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.schema 2 | "Creating Datomic schemas from specifications" 3 | (:refer-clojure :exclude [read-string read assoc!]) 4 | (:use [spark.spec-tacular :exclude [diff]] 5 | spark.spec-tacular.spec 6 | spark.spec-tacular.datomic 7 | [clojure.string :only [lower-case]]) 8 | (:require [clojure.core.typed :as t] 9 | [clojure.edn :as edn] 10 | [spark.spec-tacular.datomic :as sd] 11 | [spark.spec-tacular.datomic.util :refer :all] 12 | [clojure.java.io :as io]) 13 | (:import spark.spec_tacular.spec.Spec 14 | spark.spec_tacular.spec.EnumSpec)) 15 | 16 | (t/typed-deps spark.spec-tacular 17 | spark.spec-tacular.datomic) 18 | 19 | (require '[datomic.api :as d]) 20 | 21 | (t/defalias EntityMap 22 | "An EntityMap is a (possibly partial) description of a Datomic entity." 23 | (t/HMap :mandatory 24 | {:db/ident t/Keyword} 25 | :optional 26 | {:db/id datomic.db.DbId 27 | :db/valueType t/Any 28 | :db/cardinality (t/U ':db.cardinality/one ':db.cardinality/many) 29 | :db/fn (t/Map t/Keyword t/Any) 30 | :db.install/_attribute t/Keyword})) 31 | (t/defalias InstallableEntityMap 32 | "A a full description of a Datomic entity that can be installed as 33 | part of a Datomic schema." 34 | (t/HMap :mandatory 35 | {:db/id datomic.db.DbId 36 | :db/ident t/Keyword 37 | :db/valueType t/Any 38 | :db/cardinality (t/U ':db.cardinality/one ':db.cardinality/many) 39 | :db.install/_attribute (t/U (t/Val :db.part/db))} 40 | :optional 41 | {:db/fn (t/Map t/Keyword t/Any) 42 | :db/doc t/Str})) 43 | 44 | (t/defalias Schema 45 | "A list of mappings that can be used as a 46 | [Datomic schema](http://docs.datomic.com/schema.html). Schemas can 47 | be created from sequences or namespaces containing [[defspec]]s, or 48 | can be recreated from files and databases." 49 | (t/Seq EntityMap)) 50 | 51 | ;; A Delta is a Schema; but it is not intended to be used as a Datomic schema. 52 | ;; Instead, it represents the change between two Schemas 53 | ;; Deltas can be created by computing the difference between two Schemas 54 | ;; Deltas can be recreated from files 55 | (t/defalias ^:no-doc Delta Schema) 56 | 57 | (t/def ^:private datomic-base-attributes :- (t/Coll t/Keyword) 58 | #{:db.alter/attribute :db.install/partition :db/excise :db/lang 59 | :db.install/function :db/noHistory :db/txInstant :spec-tacular/spec 60 | :db.excise/attrs :db/ident :db/cardinality :db/index :db.install/valueType 61 | :db/fn :db/isComponent :db/code :db/unique :db.excise/beforeT :db.excise/before 62 | :db/valueType :fressian/tag :db/doc :db.install/attribute :db/fulltext 63 | :db.sys/reId :db.sys/partiallyIndexed}) 64 | 65 | (t/ann ^:no-check spec-tacular-map InstallableEntityMap) 66 | (def 67 | ^{:doc "The map for the special `:spec-tacular/spec` ident which 68 | must be installed on any database hoping to use spec-tacular. 69 | Automatically installed when using [[to-database!]]."} 70 | spec-tacular-map 71 | {:db/id (d/tempid :db.part/db), 72 | :db/ident :spec-tacular/spec, 73 | :db/valueType :db.type/keyword, 74 | :db/cardinality :db.cardinality/one, 75 | :db/doc "spec-tacular/spec type tag", 76 | :db.install/_attribute :db.part/db}) 77 | 78 | (t/ann ^:no-check item->schema-map [SpecT Item -> EntityMap]) 79 | (defn- item->schema-map 80 | [spec {iname :name [cardinality type] :type :as item}] 81 | (merge 82 | {:db/id (d/tempid :db.part/db) 83 | :db/ident (keyword (datomic-ns spec) (name iname)) 84 | :db/valueType (if (primitive? type) 85 | (if (instance? EnumSpec (get-spec type)) 86 | :db.type/ref 87 | (if (= type :calendarday) 88 | (keyword "db.type" "instant") 89 | (keyword "db.type" (name type)))) 90 | :db.type/ref) 91 | :db/cardinality (case cardinality 92 | :one :db.cardinality/one 93 | :many :db.cardinality/many) 94 | :db/doc (or (:doc item) 95 | "") 96 | :db.install/_attribute :db.part/db} 97 | (when (:unique? item) 98 | {:db/unique (if (:identity? item) 99 | :db.unique/identity 100 | :db.unique/value)}) 101 | (when (:component? item) 102 | {:db/isComponent true}))) 103 | 104 | (t/ann ^:no-check from-spec [(t/U SpecT t/Keyword) -> Schema]) 105 | (defn from-spec 106 | "Generates a [[Schema]] that represents `spec`." 107 | [spec-kw] 108 | (let [spec (if (keyword? spec-kw) (get-spec spec-kw) spec-kw)] 109 | (assert spec (str "cannot find spec for " spec-kw)) 110 | (condp instance? spec 111 | Spec (t/for [item :- Item (:items spec)] :- EntityMap 112 | (item->schema-map spec item)) 113 | EnumSpec (t/for [kw :- t/Keyword (:values spec)] :- EntityMap 114 | {:db/id (d/tempid :db.part/user) 115 | :db/ident kw})))) 116 | 117 | (t/ann normalize [Schema -> Schema]) 118 | (defn normalize 119 | "Normalizes `schema` for comparison: 120 | 121 | * removes any mappings for attributes that Datomic adds automatically 122 | * removes `:db/id` and `:db.install/_attribute` attributes from each mapping 123 | * ensures each entry has a `:db/unique` attribute, even if it's `nil` 124 | * simplifies `:db/fn` fields so that they are comparable with `=`" 125 | [schema] 126 | (->> schema 127 | (filter #(not (contains? datomic-base-attributes (:db/ident %)))) 128 | (map (t/fn [m :- EntityMap] :- EntityMap 129 | (dissoc m :db/id :db.install/_attribute))) 130 | (map (t/fn [m :- EntityMap] :- EntityMap 131 | (assoc m :db/unique (:db/unique m)))) 132 | (map (t/fn [m :- EntityMap] :- EntityMap 133 | (if-let [txn-fn (:db/fn m)] 134 | (assoc m :db/fn (dissoc (into {} txn-fn) :fnref :pending)) m))))) 135 | 136 | (t/ann ^:no-check from-file [java.io.File -> Schema]) 137 | (defn from-file 138 | "Returns the [[Schema]] inside the given file" 139 | [schema-file] 140 | (edn/read-string {:readers *data-readers*} (slurp schema-file))) 141 | 142 | (t/ann ^:no-check read-string [t/Str -> Schema]) 143 | (defn read-string 144 | "Returns the [[Schema]] inside the given string" 145 | [s] 146 | (edn/read-string {:readers *data-readers*} s)) 147 | 148 | (t/ann ^:no-check read [java.io.PushbackReader -> Schema]) 149 | (defn read 150 | "Returns the [[Schema]] inside the given stream" 151 | [stream] 152 | (edn/read {:readers *data-readers*} stream)) 153 | 154 | (t/ann ^:no-check write [Schema java.io.Writer -> nil]) 155 | (t/defn write 156 | "Writes the schema to w, adding in [[spec-tacular-map]]." 157 | [schema w] 158 | (t/let [write :- [java.lang.String -> nil] 159 | ,#(.write ^java.io.Writer w ^java.lang.String %) 160 | sorted-cols :- Schema 161 | (map #(into (sorted-map) %) schema) 162 | sorted-rows :- Schema 163 | (sort-by :db/ident (map #(into (sorted-map) %) sorted-cols))] 164 | (write "[") 165 | (t/doseq [m :- EntityMap (cons spec-tacular-map sorted-rows)] 166 | (write "\n") 167 | ;; regexp: #db/id[:db.part/db -1003792] ==> #db/id[:db.part/db] 168 | ;; TODO: is that regexp qualified enough? 169 | (write (clojure.string/replace (str m) #"(db|user) -(\d+)" "$1"))) 170 | (write "\n]\n"))) 171 | 172 | (t/ann ^:no-check to-file [Schema java.io.File -> nil]) 173 | (defn to-file 174 | "Writes `schema` to `file`, returns `nil`." 175 | [schema file] 176 | (with-open [f (io/writer file)] (write schema f))) 177 | 178 | (t/ann ^:no-check diff [Schema Schema -> '[(t/Set EntityMap) (t/Set EntityMap) (t/Set EntityMap)]]) 179 | (defn diff 180 | "Returns the difference between two schemas as three sets: 181 | * the entries only in `schema1`, 182 | * the entries only in `schema2`, 183 | * the entries in both `schema1` and `schema2`" 184 | [schema1 schema2] 185 | (clojure.data/diff (set (normalize schema1)) 186 | (set (normalize schema2)))) 187 | 188 | ;; TODO: this is a diff not a check, checks throw errors 189 | (t/ann ^:no-check check [Schema SpecT -> (t/ASeq t/Str)]) 190 | (defn ^:no-doc check 191 | "Returns a list of errors representing discrepencies between the 192 | given spec and schema." 193 | [schema spec] 194 | (letfn [(reduce-component [m v] (assoc m (-> v :db/ident name keyword) v)) 195 | (reduce-items [m v] (assoc m (:name v) v)) 196 | (check [v m] (if v nil m)) 197 | (all-errors [& rest] (filter some? (flatten rest))) 198 | (diff-uniques [[{schema-uniq :db/unique} 199 | {iname :name item-uniq :unique? item-ident :identity?}]] 200 | (check (case schema-uniq 201 | nil (not (or item-uniq item-ident)) 202 | :db.unique/value (and item-uniq (not item-ident)) 203 | :db.unique/identity (and item-uniq item-ident)) 204 | (format "uniqueness for field %s in %s is inconsistant" 205 | iname (:name spec))))] 206 | (let [{sname :name 207 | opts :opts 208 | items :items} spec 209 | spec-name (-> sname name lower-case) 210 | relevant-schema (filter 211 | #(= spec-name (namespace (:db/ident %))) 212 | schema) 213 | component-by-name (reduce reduce-component {} relevant-schema) 214 | item-by-name (reduce reduce-items {} (:items spec)) 215 | schema-keys (set (keys component-by-name)) 216 | name-keys (set (keys item-by-name)) 217 | component->item (map 218 | #(vector (% component-by-name) (% item-by-name)) 219 | schema-keys)] 220 | (all-errors 221 | (check (= schema-keys name-keys) 222 | (format "inconsistent keys between schema and spec. Diff: %s" 223 | (clojure.data/diff schema-keys name-keys))) 224 | (map diff-uniques component->item) 225 | ;; TODO: Add more checks! Be strict! 226 | )))) 227 | 228 | (t/ann from-specs [(t/Seqable (t/U SpecT t/Keyword)) -> Schema]) 229 | (defn from-specs 230 | "Converts a sequence of specs (which may be actual spec objects or 231 | keywords) into a [[Schema]]" 232 | [specs] 233 | (->> specs (mapcat from-spec))) 234 | 235 | (t/ann ^:no-check from-namespace [clojure.lang.Namespace -> Schema]) 236 | (defn from-namespace 237 | "Converts all specs in `namespace` into a [[Schema]]" 238 | [namespace] 239 | (->> namespace 240 | namespace->specs 241 | (filter #(or (instance? EnumSpec %) (instance? Spec %))) 242 | from-specs)) 243 | 244 | (t/defalias URI "A URI is just a string, but it should probably look like `\"datomic:mem://\"`" t/Str) 245 | (t/ann ^:no-check datomic.api/squuid [-> java.util.UUID]) 246 | (t/ann ^:no-check datomic.api/create-database [URI -> nil]) 247 | (t/ann ^:no-check datomic.api/delete-database [URI -> nil]) 248 | (t/ann ^:no-check datomic.api/connect [URI -> Connection]) 249 | (t/ann ^:no-check datomic.api/db [Connection -> Database]) 250 | 251 | (t/ann fresh-db! (t/IFn [-> Connection] 252 | [URI -> Connection])) 253 | (defn- fresh-db! 254 | "Creates a fresh database. Returns a connection to that database. 255 | If it already exists, requires user interaction on stdin to proceed as this could erase the db." 256 | ([] (fresh-db! (str "datomic:mem://" (d/squuid)))) 257 | ([uri] 258 | (let [created? (d/create-database uri)] 259 | (when-not created? 260 | (let [confirm-num (+ 10 (rand-int 90))] 261 | (if (not= "bypass" (System/getenv "SP_DANGER_DANGER__BYPASS_DB_RESET_PROMPT")) 262 | (do 263 | (println "CAUTION: You are about to erase the db: " uri 264 | "\nPlease enter the number" confirm-num 265 | "to confirm you want to proceed.") 266 | (let [inp (read-line)] 267 | (assert (= inp (str confirm-num)) 268 | (str "stdin "inp" didn't match "confirm-num))))) 269 | (d/delete-database uri) 270 | (d/create-database uri) 271 | (println "Created fresh db."))) 272 | (d/connect uri)))) 273 | 274 | (t/ann ^:no-check to-database! (t/IFn [Schema -> Connection] 275 | [Schema URI -> Connection])) 276 | (defn to-database! 277 | "Creates a fresh database with `schema` installed and returns a 278 | connection to that database. If the schema does not already 279 | contain [[spec-tacular-map]], it is added. 280 | 281 | Installs at `uri` if supplied." 282 | ([schema] 283 | (let [connection (fresh-db!) 284 | schema (if (some #(= (:db/ident %) :spec-tacular/spec) schema) schema 285 | (cons spec-tacular-map schema))] 286 | (do @(d/transact connection schema) connection))) 287 | ([schema uri] 288 | (let [connection (fresh-db! uri) 289 | schema (if (some #(= (:db/ident %) :spec-tacular/spec) schema) schema 290 | (cons spec-tacular-map schema))] 291 | (do @(d/transact connection schema) connection)))) 292 | 293 | (t/ann ^:no-check from-database [(t/U Database Connection ConnCtx) -> Schema]) 294 | (defn from-database 295 | "Returns the Schema in the given [[Database]], [[Connection]], or 296 | [[spark.spec-tacular.datomic/ConnCtx]]." 297 | [db] 298 | (let [db (cond 299 | (instance? datomic.peer.LocalConnection db) (d/db db) 300 | (map? db) (sd/db db) 301 | :else db)] 302 | (->> (d/q '[:find ?attr :where [_ :db.install/attribute ?attr]] db) 303 | ;; -- collects all entities that have been installed 304 | (map #(->> % first (d/entity db) (into {}))) 305 | ;; -- filters out those installed by datomic 306 | (filter #(not (contains? datomic-base-attributes (:db/ident %))))))) 307 | 308 | (t/defn ^:no-doc delta 309 | "Computes Delta between two Schemas" 310 | [old :- Schema, new :- Schema] :- Schema 311 | (let [[removed-entries new-entries both] (diff old new)] 312 | (when removed-entries 313 | (throw (ex-info "Deletion and renaming not supported" 314 | {:removed-entries removed-entries 315 | :new-entries new-entries}))) 316 | (let [old-idents (into #{} (map :db/ident removed-entries)) 317 | new-idents (into #{} (map :db/ident new-entries))] 318 | (filter #(contains? new-idents (:db/ident %)) new)))) 319 | -------------------------------------------------------------------------------- /src/spark/spec_tacular/spec.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.spec 2 | (:require [clojure.pprint :as pp] 3 | [clj-time.core :as time] 4 | [clj-time.format :as timef] 5 | [clj-time.coerce :as timec])) 6 | 7 | ;; ----------------------------------------------------------------------------- 8 | ;; records 9 | 10 | (defrecord Spec [name opts items syntax]) 11 | (defrecord Item [name type precondition required? unique? optional? identity? default-value parent-name]) 12 | (defrecord UnionSpec [name elements]) 13 | (defrecord SpecType [name type type-symbol coercion]) 14 | (defrecord EnumSpec [name values]) 15 | 16 | ;; ----------------------------------------------------------------------------- 17 | ;; printing 18 | 19 | (defmethod pp/simple-dispatch Spec [spec] 20 | (let [stx (.syntax spec)] 21 | (pp/pprint-logical-block 22 | :prefix "(" :suffix ")" 23 | (pp/simple-dispatch (symbol (str (first stx) " " (second stx) " "))) 24 | (pp/pprint-indent :block 1) 25 | (doseq [item-stx (rest (rest stx))] 26 | (pp/pprint-newline :linear) 27 | (if (= (first item-stx) :link) 28 | (pp/pprint-logical-block 29 | :prefix "(" :suffix ")" 30 | (pp/simple-dispatch (symbol (str :link " "))) 31 | (pp/pprint-indent :block 0) 32 | (doseq [link (rest item-stx)] 33 | (pp/pprint-newline :mandatory) 34 | (pp/simple-dispatch link))) 35 | (pp/simple-dispatch item-stx)))))) 36 | 37 | ;; ----------------------------------------------------------------------------- 38 | ;; helpers 39 | 40 | (defn make-name 41 | "Creates a symbol using the name of the spec and the given 42 | `append-fn`." 43 | [spec append-fn] 44 | (-> spec :name name append-fn symbol)) 45 | 46 | (defn spec->class 47 | "Returns the symbol for the spec's class" 48 | [spec] 49 | (make-name spec #(str "i_" %))) 50 | 51 | (defn spec->ctor 52 | "Returns the symbol for the spec's ctor" 53 | [spec] 54 | (make-name spec clojure.string/lower-case)) 55 | 56 | (defn spec->huh 57 | [spec] 58 | (make-name spec #(str (clojure.string/lower-case %) "?"))) 59 | 60 | (defn spec->alias 61 | [spec] 62 | (make-name spec identity)) 63 | 64 | ;; ----------------------------------------------------------------------------- 65 | ;; primitive types 66 | 67 | ;;;; There is no existing Java class for a primitive byte array 68 | (def Bytes (class (byte-array [1 2]))) 69 | 70 | (def type-map 71 | (reduce 72 | (fn [m [n t ts c]] 73 | (assoc m n (map->SpecType {:name n :type t :type-symbol ts :coercion c}))) 74 | {} 75 | [[:keyword clojure.lang.Keyword `clojure.lang.Keyword keyword] 76 | [:string String `String nil] ; str Q: Do we lean on "str" coercion? 77 | [:boolean Boolean `Boolean boolean] 78 | [:long Long `Long long] 79 | [:bigint java.math.BigInteger `java.math.BigInteger bigint] 80 | [:float Float `Float float] 81 | [:double Double `Double double] 82 | [:bigdec java.math.BigDecimal `java.math.BigDecimal bigdec] 83 | [:instant java.util.Date `java.util.Date nil] 84 | [:calendarday org.joda.time.DateTime `org.joda.time.DateTime timec/to-date-time] 85 | [:uuid java.util.UUID `java.util.UUID #(if (string? %) (java.util.UUID/fromString %) %)] 86 | [:uri java.net.URI `java.net.URI nil] 87 | [:bytes Bytes `Bytes nil]])) 88 | 89 | (def ^:constant core-types (into #{} (keys type-map))) 90 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/datomic/pull_helpers_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.pull-helpers-test 2 | (:refer-clojure :exclude [assoc!]) 3 | (:require [clj-time.core :as time] 4 | [clojure.test :refer :all] 5 | [datomic.api :as d] 6 | [spark.spec-tacular :refer [refless=]] 7 | [spark.spec-tacular.datomic :refer :all :exclude [db]] 8 | [spark.spec-tacular.datomic.pull-helpers :refer :all] 9 | [spark.spec-tacular.schema :as schema] 10 | [spark.spec-tacular.test-specs :refer :all] 11 | [spark.spec-tacular.test-utils :refer [with-test-db *conn* db]])) 12 | 13 | (def simple-schema 14 | (cons schema/spec-tacular-map 15 | (schema/from-namespace (the-ns 'spark.spec-tacular.test-specs)))) 16 | 17 | (deftest test-datomify-spec-pattern 18 | (testing "simple pulls of constants" 19 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Scm2 [:val1])] 20 | (is (= datomic-pattern 21 | [:scm2/val1])) 22 | (is (= (rebuild nil {:scm2/val1 12345}) 23 | {:val1 12345})) 24 | (is (= (rebuild nil {}) 25 | {}))) 26 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Scm [{:scm2 [:val1]}])] 27 | (is (= datomic-pattern 28 | [{:scm/scm2 [:scm2/val1]}])) 29 | (is (= (rebuild nil {:scm/scm2 {:scm2/val1 12345}}) 30 | {:scm2 {:val1 12345}}))) 31 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Scm [:val1])] 32 | (is (= datomic-pattern 33 | [:scm/val1])) 34 | (is (= (rebuild nil {:scm/val1 "12345"}) 35 | {:val1 "12345"}))) 36 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Scm [:val1 {:scm2 [:val1]}])] 37 | (is (= datomic-pattern 38 | [:scm/val1 {:scm/scm2 [:scm2/val1]}])) 39 | (is (= (rebuild nil {:scm/scm2 {:scm2/val1 12345}}) 40 | {:scm2 {:val1 12345}})) 41 | (is (= (rebuild nil {:scm/val1 "12345" :scm/scm2 {:scm2/val1 12345}}) 42 | {:val1 "12345" :scm2 {:val1 12345}})))) 43 | (testing "backwards" 44 | (is (= (select-keys (backwards :Scm :scm2) [:name :parent-name]) 45 | {:name :scm2 :parent-name :Scm})) 46 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Scm2 [(backwards :Scm :scm2)])] 47 | (is (= datomic-pattern 48 | [:scm/_scm2])) 49 | (with-test-db simple-schema 50 | (let [scm (create! {:conn *conn*} (scm {:scm2 {:val1 12345}})) 51 | pulled (d/pull (db) [:scm/_scm2] (get-eid (db) (:scm2 scm)))] 52 | (is (= pulled 53 | {:scm/_scm2 [{:db/id (get-eid (db) scm)}]})) 54 | (is (= (rebuild (db) pulled) 55 | {(backwards :Scm :scm2) [scm]})) 56 | (is (= (get (rebuild (db) pulled) 57 | (backwards :Scm :scm2)) 58 | [scm]))))) 59 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Scm2 [{(backwards :Scm :scm2) [:val1]}])] 60 | (is (= datomic-pattern 61 | [{:scm/_scm2 [:scm/val1]}])) 62 | (with-test-db simple-schema 63 | (let [scm (create! {:conn *conn*} (scm {:val1 "12345" :scm2 {:val1 12345}})) 64 | pulled (d/pull (db) [{:scm/_scm2 [:scm/val1]}] (get-eid (db) (:scm2 scm)))] 65 | (is (= pulled 66 | {:scm/_scm2 [{:scm/val1 "12345"}]})) 67 | (is (= (rebuild (db) pulled) 68 | {(backwards :Scm :scm2) [{:val1 "12345"}]})))))) 69 | (testing "empty" 70 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Scm3 [:val1])] 71 | (is (= datomic-pattern 72 | [])) 73 | (is (= (rebuild nil nil) 74 | {})) 75 | (is (= (rebuild nil {}) 76 | {})))) 77 | (testing "enum" 78 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern ScmEnum [:val1])] 79 | (is (= datomic-pattern 80 | [:scm2/val1 :scm/val1])) 81 | (is (= (rebuild nil {:scm2/val1 12345}) 82 | {:val1 12345})) 83 | (is (= (rebuild nil {:scm/val1 "12345"}) 84 | {:val1 "12345"}))) 85 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern ScmOwnsEnum [:enum {:enums [:val1]}])] 86 | (is (= datomic-pattern 87 | [:scmownsenum/enum 88 | {:scmownsenum/enums [:scm2/val1 89 | :scm/val1]}])) 90 | (with-test-db simple-schema 91 | (let [soe (->> (scmownsenum {:enum (scm {:val2 123}) 92 | :enums [(scm {:val1 "123"}) 93 | (scm2 {:val1 123}) 94 | (scm3)]}) 95 | (create! {:conn *conn*})) 96 | pulled (d/pull (db) datomic-pattern (get-eid (db) soe))] 97 | (is (= pulled 98 | {:scmownsenum/enum {:db/id (get-eid (db) (:enum soe))} 99 | :scmownsenum/enums [{:scm/val1 "123"} {:scm2/val1 123}]})) 100 | (is (= (rebuild (db) {:scmownsenum/enums [{:scm/val1 "123"} {:scm2/val1 123}]}) 101 | {:enums [{:val1 "123"} {:val1 123}]})) 102 | (is (= (rebuild (db) pulled) 103 | {:enum (:enum soe) 104 | :enums [{:val1 "123"} {:val1 123}]})))))) 105 | (testing "component" 106 | (with-test-db simple-schema 107 | (let [c (->> (container {:number 1 108 | :one (container {:number 2}) 109 | :many [(container {:number 3}) 110 | (container {:number 4})]}) 111 | (create! {:conn *conn*}))] 112 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Container [{(backwards :Container :one) 113 | [:number]}]) 114 | pulled {:container/_one {:container/number 1}}] 115 | (is (= datomic-pattern 116 | [{:container/_one [:container/number]}])) 117 | (is (= (d/pull (db) datomic-pattern (get-eid (db) (:one c))) 118 | pulled)) 119 | (is (= (rebuild (db) pulled) 120 | {(backwards :Container :one) 121 | {:number 1}})) 122 | (is (= (pull (db) [{(backwards :Container :one) [:number]}] (:one c)) 123 | {(backwards :Container :one) {:number 1}}))) 124 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Container [(backwards :Container :one)]) 125 | pulled {:container/_one {:db/id (get-eid (db) c)}}] 126 | (is (= datomic-pattern 127 | [:container/_one])) 128 | (is (= (d/pull (db) datomic-pattern (get-eid (db) (:one c))) 129 | pulled)) 130 | (is (= (rebuild (db) pulled) 131 | {(backwards :Container :one) c}))) 132 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Container [:many]) 133 | cs (sort-by :number (:many c)) 134 | pulled {:container/many [{:db/id (get-eid (db) (first cs)) 135 | :spec-tacular/spec :Container 136 | :container/number 3} 137 | {:db/id (get-eid (db) (second cs)) 138 | :spec-tacular/spec :Container 139 | :container/number 4}]}] 140 | (is (= datomic-pattern 141 | [:container/many])) 142 | (is (= (set (:container/many (d/pull (db) datomic-pattern (get-eid (db) c)))) 143 | (set (:container/many pulled)))) 144 | (is (refless= (set (:many (rebuild (db) pulled))) 145 | (:many c)) 146 | "they aren't = anymore because they were pulled off the database at different times, but at least they're refless=")) 147 | (testing "forward component" 148 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Container [{:many [:number]}]) 149 | cs (sort-by :number (:many c)) 150 | pulled {:container/many [{:db/id (get-eid (db) (first cs)) 151 | :spec-tacular/spec :Container 152 | :container/number 3} 153 | {:db/id (get-eid (db) (second cs)) 154 | :spec-tacular/spec :Container 155 | :container/number 4}]}] 156 | (is (= datomic-pattern 157 | [{:container/many [:container/number]}])) 158 | (is (= (d/pull (db) datomic-pattern (get-eid (db) c)) 159 | {:container/many [{:container/number 4} {:container/number 3}]})) 160 | (is (= (set (:many (rebuild (db) pulled))) 161 | #{{:number 3} {:number 4}})))) 162 | (testing "backwards component" 163 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Container 164 | [{(backwards :Container :many) 165 | [:number]} 166 | [:number]]) 167 | pulled {:container/number 3, :container/_many {:container/number 1}} 168 | cs (sort-by :number (:many c))] 169 | (is (= datomic-pattern 170 | [{:container/_many [:container/number]} 171 | :container/number])) 172 | (is (= (d/pull (db) datomic-pattern (get-eid (db) (first cs))) 173 | pulled)) 174 | (is (= (rebuild (db) pulled) 175 | {(backwards :Container :many) {:number 1} 176 | :number 3}))))))) 177 | (testing "enumeration" 178 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Spotlight [:color])] 179 | (is (= datomic-pattern 180 | [{:spotlight/color [:db/ident]}])) 181 | (with-test-db simple-schema 182 | (let [spotlight (create! {:conn *conn*} (spotlight {:color :LenseColor/red})) 183 | pulled (d/pull (db) datomic-pattern (get-eid (db) spotlight))] 184 | (is (= pulled 185 | {:spotlight/color {:db/ident :LenseColor/red}})) 186 | (is (= (rebuild (db) pulled) 187 | {:color :LenseColor/red})))))) 188 | (testing "calendarday" 189 | (let [{:keys [datomic-pattern rebuild]} (datomify-spec-pattern Birthday [:date])] 190 | (is (= datomic-pattern 191 | [:birthday/date])) 192 | (with-test-db simple-schema 193 | (let [b (create! {:conn *conn*} (birthday {:date (time/date-time 2015)})) 194 | pulled (d/pull (db) datomic-pattern (get-eid (db) b))] 195 | (is (= pulled 196 | {:birthday/date #inst "2015-01-01"})) 197 | (is (= (rebuild (db) pulled) 198 | {:date (time/date-time 2015 1)}))))))) 199 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/datomic/pull_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.pull-test 2 | (:refer-clojure :exclude [assoc!]) 3 | (:require [clojure.test :refer :all] 4 | [datomic.api :as d] 5 | [spark.spec-tacular :refer [refless=]] 6 | [spark.spec-tacular.datomic :refer :all :exclude [db]] 7 | [spark.spec-tacular.datomic.pull-helpers :refer :all] 8 | [spark.spec-tacular.schema :as schema] 9 | [spark.spec-tacular.test-specs :refer :all] 10 | [spark.spec-tacular.test-utils :refer [with-test-db *conn* db]])) 11 | 12 | (def simple-schema 13 | (cons schema/spec-tacular-map 14 | (schema/from-namespace (the-ns 'spark.spec-tacular.test-specs)))) 15 | 16 | (deftest test-pull 17 | (testing "enums" 18 | (with-test-db simple-schema 19 | (let [spotlight (create! {:conn *conn*} (spotlight {:color :LenseColor/red}))] 20 | (is (= (pull (db) [:color] spotlight) 21 | {:color :LenseColor/red}))))) 22 | 23 | (testing "unions" 24 | (with-test-db simple-schema 25 | (let [scm3 (create! {:conn *conn*} (scm3)) 26 | scm2 (create! {:conn *conn*} (scm2 {:val1 123})) 27 | scm (create! {:conn *conn*} (scm {:val1 "123" :val2 123})) 28 | soe (create! {:conn *conn*} (scmownsenum {:enums [scm scm2 scm3]}))] 29 | (is (= (pull (db) [{:enums [:val1]}] soe) 30 | {:enums [{:val1 123} {:val1 "123"}]})) 31 | (is (= (pull (db) [{:enums [:val1 :val2]}] soe) 32 | {:enums [{:val1 123} {:val1 "123" :val2 123}]})))))) 33 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/datomic/query_helpers_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.query-helpers-test 2 | "tests helpers for sd/q and sd/query" 3 | (:refer-clojure :exclude [assoc!]) 4 | (:require [clj-time.core :as time] 5 | [clojure.set :refer [map-invert]] 6 | [clojure.test :refer :all] 7 | [datomic.api :as d] 8 | [spark.spec-tacular :refer [get-item get-spec]] 9 | [spark.spec-tacular.datomic :refer [create!]] 10 | [spark.spec-tacular.datomic.query-helpers :refer :all] 11 | [spark.spec-tacular.schema :as schema] 12 | [spark.spec-tacular.test-specs :refer :all] 13 | [spark.spec-tacular.test-utils :refer [with-test-db *conn* db]])) 14 | 15 | (def simple-schema 16 | (cons schema/spec-tacular-map 17 | (schema/from-namespace (the-ns 'spark.spec-tacular.test-specs)))) 18 | 19 | ;; --------------------------------------------------------------------------------------------------- 20 | ;; static 21 | 22 | (deftest test-expand-helpers 23 | (testing "keyword as find variable" 24 | #_(q :find :ScmKw :in (db) :where 25 | [% {:item :test}]) 26 | (let [tenv (atom {}), uenv (atom {})] 27 | (expand-find-elems tenv uenv '(:ScmKw)) 28 | (is (contains? @uenv '%1)) 29 | (is (contains? (map-invert @tenv) :ScmKw)))) 30 | 31 | (testing "spec cast" 32 | #_(q :find :keyword :in (db) :where 33 | [:ScmKw {:item [:keyword %]}]) 34 | (let [tenv (atom {})] 35 | (is (= (expand-item tenv :ScmKw :item '[:keyword ?x]) 36 | {:map-entry [[:item `'~'?x]]})) 37 | (is (= (get @tenv '?x) 38 | :keyword)))) 39 | 40 | (testing "find var spec cast" 41 | #_(q :find [:Scm ...] :in (db) :where 42 | [:ScmMWrap {:val [:ScmM {:val [% {:val1 "foobar"}]}]}]) 43 | (is (= (count (expand-spec-where-clause (atom {'?scm :Scm}) 44 | '[:ScmMWrap {:val [:ScmM {:val [?scm {:val1 "foobar"}]}]}])) 45 | 3))) 46 | 47 | (testing "test union spec" 48 | #_(q :find :Animal :in (db) :where [% {:name "zuzu"}]) 49 | (is (expand-spec-where-clause (atom {'?animal :Animal}) 50 | '[?animal {:name "zuzu"}]))) 51 | 52 | (testing "keyword as map rhs" 53 | (is (= (count (expand-spec-where-clause (atom {'?soe :ScmOwnsEnum}) 54 | '[?soe {:enum :Scm2}])) 55 | 2))) 56 | 57 | (testing "cast as rhs" 58 | (is (expand-spec-map-clause (atom {'?se :Animal}) 59 | Animal 60 | '?se 61 | '{:name ?name})))) 62 | 63 | (deftest test-parse-query 64 | (is (parse-query '(:find :Animal :in (db) :where [% {:name "zuzu"}]))) 65 | (is (parse-query '(:find :Scm2 :in (db) :where [:Scm {:scm2 %}]))) 66 | (is (= (-> (parse-query '(:find :House, :Person :in db :where 67 | [%1 {:occupants %2 :mailbox {:has-mail? true}}])) 68 | :where-expr (nth 2) rest) 69 | [:spec-tacular/spec :Person])) 70 | (is (parse-query '(:find ?scm2 . :in (db) :where [?scm [:Scm {:scm2 ?scm2}]] [?scm :scm/scm2 ?scm2]))) 71 | (is (parse-query '(:find [:Scm ?direction] :in db :where 72 | (or (and [% {:val2 5}] 73 | [(ground :incoming) ?direction]) 74 | (and [% {:val2 6}] 75 | [(ground :outgoing) ?direction]))))) 76 | (is (parse-query '(:find [:ScmOwnsEnum ...] :in db :where [% {:enum :Scm2}]))) 77 | (is (parse-query '(:find :Birthday . 78 | :in $ 79 | :where 80 | [% {:date ?date}] 81 | [(.before ^java.util.Date ?date #inst"2017")]))) 82 | 83 | (testing "bad syntax" 84 | (is (thrown-with-msg? 85 | clojure.lang.ExceptionInfo #"invalid where clause" 86 | (parse-query '(:find :Scm2 :in (db) :where [:Scm :scm2]))) 87 | "using a (non-spec) keyword as a rhs") 88 | (is (thrown-with-msg? 89 | clojure.lang.ExceptionInfo #"could not infer type" 90 | (parse-query '(:find ?x :in (db) :where [?x {:y 5}]))) 91 | "impossible to determine spec of x") 92 | (is (thrown-with-msg? 93 | clojure.lang.ExceptionInfo #"invalid where clause" ; could specifically mention string being impossible 94 | (parse-query '(:find ?x :in (db) :where ["?x" {:y 5}]))) 95 | "using a string as an ident") 96 | (is (thrown-with-msg? 97 | clojure.lang.ExceptionInfo #"keyword not in spec" 98 | (parse-query '(:find :Scm :in (db) :where [% {:y 5}]))) 99 | "trying to specify a field that is not in the spec") 100 | (is (thrown-with-msg? 101 | clojure.lang.ExceptionInfo #"incompatible" 102 | (parse-query '(:find ?val :in (db) :where [:ScmEnum {:val1 ?val}]))) 103 | "trying to pull out a field from an enum with different field types"))) 104 | 105 | ;; --------------------------------------------------------------------------------------------------- 106 | ;; dynamic 107 | 108 | (deftest test-combine-where-clauses 109 | (is (= (combine-where-clauses '(and [1] [2] [3]) 110 | '(and [4] [5] [6])) 111 | (combine-where-clauses [1] 112 | [2] 113 | [3] 114 | '(and [4] [5] [6])) 115 | '(and [1] [2] [3] [4] [5] [6]))) 116 | (is (= (combine-where-clauses '(or (and [1]) 117 | (and [2]))) 118 | '(or (and [1]) 119 | (and [2]))))) 120 | 121 | (deftest test-datomify-spec-where-clause 122 | (is (= (datomify-spec-where-clause :Animal 123 | '?animal 124 | '{:spec-tacular/spec :Animal 125 | :name "zuzu"}) 126 | '(or (and [?animal :spec-tacular/spec :Ferret] 127 | [?animal :ferret/name "zuzu"]) 128 | (and [?animal :spec-tacular/spec :Mouse] 129 | [?animal :mouse/name "zuzu"]))))) 130 | 131 | (deftest test-datomify-where-clause 132 | (is (= (datomify-where-clause '(not [?scm {:spec-tacular/spec :Scm, :val2 5}])) 133 | '(not (and [?scm :spec-tacular/spec :Scm] 134 | [?scm :scm/val2 5])))) 135 | (is (= (datomify-where-clause '(not-join [?scm] 136 | [?scm {:spec-tacular/spec :Scm, :val2 5}])) 137 | '(not-join [?scm] 138 | [?scm :spec-tacular/spec :Scm] 139 | [?scm :scm/val2 5]))) 140 | (is (= (datomify-where-clause '[(.before ?date1 ?date2)]) 141 | '[(.before ?date1 ?date2)])) 142 | (is (= (datomify-where-clause '[(ground :keyword) ?kw]) 143 | '[(ground :keyword) ?kw])) 144 | (testing "calendarday" 145 | (is (= (datomify-where-clause ['?date {:spec-tacular/spec :Birthday 146 | :date (time/date-time 2015)}]) 147 | '(and 148 | [?date :spec-tacular/spec :Birthday] 149 | [?date :birthday/date #inst "2015-01-01T00:00:00.000-00:00"])))) 150 | (testing "passing in an instance" 151 | (is (= (rest (last (datomify-where-clause ['scmp {:spec-tacular/spec :ScmParent 152 | :scm (scm {:val1 "3"})}]))) 153 | '[:scm/val1 "3"]) 154 | "pulls the 3 out of the given scm") 155 | (is (= (datomify-where-clause ['scmp {:spec-tacular/spec :ScmParent 156 | :scm (scm {:db-ref {:eid 1}})}]) 157 | '(and [scmp :spec-tacular/spec :ScmParent] 158 | [scmp :scmparent/scm 1])) 159 | "just uses the db-ref of the scm") 160 | (is (= (datomify-where-clause ['scmp {:spec-tacular/spec :ScmParent 161 | :scm '?scm}]) 162 | '(and [scmp :spec-tacular/spec :ScmParent] 163 | [scmp :scmparent/scm ?scm])) 164 | "but it's still ok to get one as output")) 165 | (testing "unions" 166 | (is (= (datomify-where-clause ['?animal {:spec-tacular/spec :Animal, :name "zuzu"}]) 167 | '(or (and [?animal :spec-tacular/spec :Ferret] 168 | [?animal :ferret/name "zuzu"]) 169 | (and [?animal :spec-tacular/spec :Mouse] 170 | [?animal :mouse/name "zuzu"]))))) 171 | (testing "lots of and clauses" 172 | (is (= (datomify-where-clause '(or (and [?scm73984 {:spec-tacular/spec :Scm, :val2 5}] 173 | [(ground :incoming) ?direction]) 174 | (and [?scm73984 {:spec-tacular/spec :Scm, :val2 6}] 175 | [(ground :outgoing) ?direction]))) 176 | '(or (and [?scm73984 :spec-tacular/spec :Scm] 177 | [?scm73984 :scm/val2 5] 178 | [(ground :incoming) ?direction]) 179 | (and [?scm73984 :spec-tacular/spec :Scm] 180 | [?scm73984 :scm/val2 6] 181 | [(ground :outgoing) ?direction])))) 182 | (is (= (datomify-where-clause '(not (and [?scm73984 {:spec-tacular/spec :Scm, :val2 5}] 183 | [(ground :incoming) ?direction]) 184 | (and [?scm73984 {:spec-tacular/spec :Scm, :val2 6}] 185 | [(ground :outgoing) ?direction]))) 186 | '(not (and [?scm73984 :spec-tacular/spec :Scm] 187 | [?scm73984 :scm/val2 5] 188 | [(ground :incoming) ?direction] 189 | [?scm73984 :scm/val2 6] 190 | [(ground :outgoing) ?direction])))))) 191 | 192 | (deftest test-datomify-find-elems 193 | (with-test-db simple-schema 194 | (let [ex (create! {:conn *conn*} (scm {:val2 123})) 195 | ey (create! {:conn *conn*} (scm {:val2 456}))] 196 | (testing "scalar" 197 | (let [{:keys [datomic-find rebuild]} (datomify-find-elems '((instance :Scm ?ex) .))] 198 | (is (= datomic-find 199 | '(?ex .))) 200 | (is (= (->> (d/q {:find datomic-find 201 | :in '($) 202 | :where '[[?ex :scm/val2 123]]} 203 | (db)) 204 | (rebuild (db))) 205 | ex))) 206 | (is (thrown? Exception (datomify-find-elems '(56 .))))) 207 | (testing "relation" 208 | (let [{:keys [datomic-find rebuild]} (datomify-find-elems '((instance :Scm ?ex) 209 | (instance :Scm ?ey)))] 210 | (is (= datomic-find 211 | '(?ex ?ey))) 212 | (is (= (->> (d/q {:find datomic-find 213 | :in '($) 214 | :where '[[?ex :scm/val2 123] 215 | [?ey :scm/val2 456]]} 216 | (db)) 217 | (rebuild (db))) 218 | #{[ex ey]})))) 219 | (testing "collection" 220 | (let [{:keys [datomic-find rebuild]} (datomify-find-elems '([(instance :Scm ?ex) ...]))] 221 | (is (= datomic-find 222 | '([?ex ...]))) 223 | (is (= (->> (d/q {:find datomic-find 224 | :in '($) 225 | :where '[[?ex :spec-tacular/spec :Scm]]} 226 | (db)) 227 | (rebuild (db))) 228 | #{ex ey})))) 229 | (testing "tuple" 230 | (let [{:keys [datomic-find rebuild]} (datomify-find-elems '([(instance :Scm ?ex) 231 | (instance :Scm ?ey)]))] 232 | (is (= datomic-find 233 | '([?ex ?ey]))) 234 | (is (= (->> (d/q {:find datomic-find 235 | :in '($) 236 | :where '[[?ex :scm/val2 123] 237 | [?ey :scm/val2 456]]} 238 | (db)) 239 | (rebuild (db))) 240 | [ex ey])))) 241 | (testing "pull" 242 | (let [{:keys [datomic-find rebuild]} (datomify-find-elems 243 | '([(spec-pull ?ex :Scm [:val2]) 244 | (instance :Scm ?ey)]))] 245 | (is (= datomic-find 246 | '([(pull ?ex [:scm/val2]) 247 | ?ey]))) 248 | (is (= (->> (d/q {:find datomic-find 249 | :in '($) 250 | :where '[[?ex :scm/val2 123] 251 | [?ey :scm/val2 456]]} 252 | (db)) 253 | (rebuild (db))) 254 | [{:val2 123} ey]))))))) 255 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/datomic/query_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.datomic.query-test 2 | "tests sd/q and sd/query" 3 | (:refer-clojure :exclude [assoc!]) 4 | (:require [clojure.test :refer :all] 5 | [datomic.api :as d] 6 | [spark.spec-tacular :refer [refless= recursive-ctor]] 7 | [spark.spec-tacular.datomic :refer :all :exclude [db]] 8 | [spark.spec-tacular.datomic.query-helpers :refer :all] 9 | [spark.spec-tacular.schema :as schema] 10 | [spark.spec-tacular.test-specs :refer :all] 11 | [spark.spec-tacular.test-utils :refer [with-test-db *conn* db]])) 12 | 13 | (def simple-schema 14 | (cons schema/spec-tacular-map 15 | (schema/from-namespace (the-ns 'spark.spec-tacular.test-specs)))) 16 | 17 | (deftest test-query 18 | (with-test-db simple-schema 19 | (is (= (query 20 | {:find (list '?a), 21 | :where 22 | (list ['?scmparent {:spec-tacular/spec :ScmParent, :scm '?scm}] 23 | ['?scm {:spec-tacular/spec :Scm, :val2 '?a}]), 24 | :in (cons '$ (list))} 25 | (db)) 26 | #{})) 27 | (is (= (query {:find (list (list 'instance :Animal '?animal)) 28 | :in (cons '$ (list)) 29 | :where (list ['?animal {:spec-tacular/spec :Animal, :name "zuzu"}])} 30 | (db)) 31 | #{})) 32 | (is (= (query '{:find ([?scm68784 ?direction]), 33 | :in ($) 34 | :where ((or (and (and [?scm68784 :spec-tacular/spec :Scm] 35 | [?scm68784 :scm/val2 5]) 36 | [(ground :incoming) ?direction]) 37 | (and (and [?scm68784 :spec-tacular/spec :Scm] 38 | [?scm68784 :scm/val2 6]) 39 | [(ground :outgoing) ?direction])))} 40 | (db)))))) 41 | 42 | (deftest test-query-pull 43 | (with-test-db simple-schema 44 | (let [ex (create! {:conn *conn*} (scm {:val1 "123" :val2 123}))] 45 | (is (= (query {:find '((spec-pull ?scm :Scm [:val1]) .) 46 | :in '($) 47 | :where '([?scm {:spec-tacular/spec :Scm 48 | :val2 ?val2}] 49 | [(- ?val2 5) ?long])} 50 | (db)) 51 | {:val1 "123"})) 52 | (is (= (query {:find '((pull ?scm [:scm/val1]) .) 53 | :in '($) 54 | :where '([?scm {:spec-tacular/spec :Scm 55 | :val2 ?val2}] 56 | [(- ?val2 5) ?long])} 57 | (db)) 58 | {:scm/val1 "123"})) 59 | (let [soe (->> (scmownsenum {:enum (scm {:val2 123}) 60 | :enums [(scm {:val1 "123"}) 61 | (scm2 {:val1 123}) 62 | (scm3)]}) 63 | (create! {:conn *conn*}))] 64 | (is (= (query {:find '([(spec-pull ?soe :ScmOwnsEnum [:enum {:enums [:val1]}]) ...]) 65 | :in '($) 66 | :where '([?soe :spec-tacular/spec :ScmOwnsEnum])} 67 | (db)) 68 | #{{:enum (:enum soe) :enums [{:val1 "123"} {:val1 123}]}})))))) 69 | 70 | (defn- ex-aggregate [x] 5) 71 | 72 | (deftest test-query-aggregation 73 | (with-test-db simple-schema 74 | (let [ex (create! {:conn *conn*} (scm {:val1 "123" :val2 123})) 75 | ey (create! {:conn *conn*} (scm {:val1 "456" :val2 456}))] 76 | (is (= (query {:find '((min ?long)) 77 | :in '($) 78 | :where '([?scm {:spec-tacular/spec :Scm 79 | :val2 ?val2}] 80 | [(- ?val2 5) ?long])} 81 | (db)) 82 | #{[118]})))) 83 | (with-test-db simple-schema 84 | (let [ex (create! {:conn *conn*} (scm {:val1 "123" :val2 123})) 85 | ey (create! {:conn *conn*} (scm {:val1 "456" :val2 456}))] 86 | (is (= (query {:find '((spark.spec-tacular.datomic.query-test/ex-aggregate ?long) .) 87 | :in '($) 88 | :where '([?scm {:spec-tacular/spec :Scm 89 | :val2 ?val2}] 90 | [(- ?val2 5) ?long])} 91 | (db)) 92 | 5)) 93 | (is (= (query {:find '((spark.spec-tacular.datomic.query-test/ex-aggregate ?long) .) 94 | :in '($) 95 | :where '([?scm {:spec-tacular/spec :Scm 96 | :val2 ?val2}] 97 | [(- ?val2 5) ?long])} 98 | (db)) 99 | 5))))) 100 | 101 | (deftest test-query-union 102 | (with-test-db simple-schema 103 | (let [f1 (create! {:conn *conn*} (ferret {:name "catsnake"})) 104 | m1 (create! {:conn *conn*} (mouse {:name "zuzu"})) 105 | _ (is (query {:find '([?animal ...]) 106 | :in '($) 107 | :where '([?animal {:spec-tacular/spec :Animal 108 | :name "zuzu"}])} 109 | (db)) 110 | #{[(mouse {:name "zuzu"})]}) 111 | m2 (create! {:conn *conn*} (mouse {:name "catsnake"})) 112 | _ (is (= (q :find [:Animal ...] :in (db) :where 113 | [% {:name "catsnake"}]) 114 | #{m2 f1}))]))) 115 | 116 | (deftest test-q-primitive-data 117 | (with-test-db simple-schema 118 | (is (= #{} (q :find ?a :in (db) :where [:ScmParent {:scm {:val2 ?a}}])) 119 | "nothing returned on fresh db.") 120 | 121 | (let [a1 (scmparent {:scm (scm {:val1 "a" :val2 1})}) 122 | a2 (scmparent {:scm (scm {:val1 "b" :val2 2})})] 123 | (create! {:conn *conn*} a1) 124 | (create! {:conn *conn*} a2)) 125 | 126 | (is (= (q :find ?a :in (db) :where 127 | [:ScmParent {:scm {:val2 ?a}}]) 128 | #{[1] [2]}) 129 | "simple one-attribute returns (a ?-prefixed symbol isn't needed- just idiomatic cf datomic)") 130 | (is (= (q :find ?a ?b :in (db) :where 131 | [:ScmParent {:scm {:val1 ?b :val2 ?a}}]) 132 | #{[1 "a"] [2 "b"]}) 133 | "multiple attribute returns") 134 | (is (contains? #{[1 "a"] [2 "b"]} 135 | (q :find [?a ?b] :in (db) :where 136 | [:ScmParent {:scm {:val1 ?b :val2 ?a}}])) 137 | "tuple") 138 | (is (contains? #{1 2} 139 | (q :find ?a . :in (db) :where 140 | [:ScmParent {:scm {:val2 ?a}}])) 141 | "scalar") 142 | (is (= (q :find ?a :in (db) :where 143 | [:ScmParent {:scm {:val1 "a" :val2 ?a}}]) 144 | #{[1]}) 145 | "can use literals in the pattern to fix values") 146 | (is (= (let [two 2] 147 | (q :find ?a :in (db) :where 148 | [:ScmParent {:scm {:val1 ?a :val2 two}}])) 149 | #{["b"]}) 150 | "can use regular variables to fix values") 151 | (is (= (q :find ?a :in (db) :where 152 | [:ScmParent {:scm {:val1 ?a :val2 (let [?a 2] ?a)}}]) 153 | #{["b"]}) 154 | "return variables respect lexical scope and don't clobber lets") 155 | (is (= (q :find ?a :in (db) :where 156 | [:ScmParent {:scm {:val1 ?a :val2 ((fn [?a] ?a) 2)}}]) 157 | #{["b"]}) 158 | "return variables respect lexical scope and don't clobber fns")) 159 | (with-test-db simple-schema 160 | (let [ex (create! {:conn *conn*} (scmkw {:item :test}))] 161 | (is (= (q :find :ScmKw :in (db) :where 162 | [% {:item :test}]) 163 | #{[ex]})) 164 | (is (= (q :find :keyword :in (db) :where 165 | [:ScmKw {:item [:keyword %]}]) 166 | #{[:test]}))))) 167 | 168 | (deftest test-q-compound-data 169 | (with-test-db simple-schema 170 | (let [e-scm2 (create! {:conn *conn*} (scm2 {:val1 5})) 171 | e-scm (create! {:conn *conn*} (scm {:val2 5 :scm2 e-scm2})) 172 | e-scmp (create! {:conn *conn*} (scmparent {:scm e-scm}))] 173 | (testing "ref back" 174 | (= (q :find ?scm2 . :in (db) :where 175 | [?scm [:Scm {:scm2 ?scm2}]] 176 | [?scm :scm/scm2 ?scm2]) 177 | (q :find ?scm2 . :in (db) :where 178 | [_ [:Scm {:scm2 ?scm2}]]) 179 | (get-in e-scm2 [:db-ref :eid]))) 180 | (testing "simple instance back" 181 | (let [a-scm2 (->> (q :find :Scm2 :in (db) :where 182 | [:Scm {:scm2 %}]) 183 | ffirst)] 184 | (is (= (:val1 a-scm2) 5) 185 | "can use keywords on returned entities") 186 | (is (= (select-keys a-scm2 [:db-ref]) 187 | (select-keys e-scm2 [:db-ref])) 188 | "allow :db-ref keyword access"))) 189 | (let [a-scm (ffirst (q :find :Scm :in (db) :where [% {:scm2 [:Scm2 {:val1 5}]}]))] 190 | (testing "equality on returned entities" 191 | (is (refless= a-scm e-scm)) 192 | (is (refless= e-scm a-scm)))) 193 | 194 | (testing "equality on returned sub-entities" 195 | (let [[a-scm a-scm2] 196 | ,(->> (q :find :Scm :Scm2 :in (db) :where 197 | [%1 {:scm2 %2}]) 198 | first)] 199 | (is (= (:scm2 a-scm) a-scm2)) 200 | (is (refless= a-scm2 e-scm2)) 201 | (is (refless= a-scm e-scm)) 202 | (is (not (:val1 a-scm))) 203 | (is (map? (:db-ref (:scm2 a-scm))) 204 | "allow :db-ref keyword access on sub-entities"))))) 205 | 206 | (with-test-db simple-schema 207 | (testing "is-many" 208 | (let [e-scmm (scmm {:identity "hi" :vals [(scm2 {:val1 42}) (scm2 {:val1 7})]}) 209 | scmm-eid (create! {:conn *conn*} e-scmm) 210 | a-scmm1 (ffirst (q :find :ScmM :in (db) :where [% {:identity "hi"}])) 211 | a-scmm2 (recursive-ctor :ScmM (d/entity (db) (get-eid (db) scmm-eid)))] 212 | (is (refless= a-scmm1 e-scmm)) 213 | (is (refless= a-scmm2 e-scmm))) 214 | 215 | (let [esw (scmmwrap 216 | {:name "scmwrap" 217 | :val (scmm {:identity "hi" :vals [(scm2 {:val1 42}) (scm2 {:val1 7})]})}) 218 | esw-id (create! {:conn *conn*} esw) 219 | asw1 (ffirst (q :find :ScmM :in (db) :where [:ScmMWrap {:name "scmwrap" :val %}])) 220 | asw2 (:val (recursive-ctor :ScmMWrap (d/entity (db) (get-eid (db) esw-id))))] 221 | ))) 222 | (with-test-db simple-schema 223 | (testing "coll" 224 | (let [ex (create! {:conn *conn*} (scmmwrap {:val {:val (scm {:val1 "foobar"})}}))] 225 | (is (contains? (q :find [:Scm ...] :in (db) :where 226 | [:ScmMWrap {:val [:ScmM {:val [% {:val1 "foobar"}]}]}]) 227 | (get-in ex [:val :val])))))) 228 | (with-test-db simple-schema 229 | (testing "absent field access" 230 | (let [eid (create! {:conn *conn*} (scm2)) 231 | a-scm2 (recursive-ctor :Scm2 (d/entity (db) (get-eid (db) eid)))] 232 | (let [b (not (:val1 (scm2 a-scm2)))] ;; lol printing it out draws an early error 233 | (is b)) 234 | #_(is (not (:val1 (scm2 a-scm2)))))))) 235 | 236 | (deftest test-q-complex-dispatch 237 | (with-test-db simple-schema 238 | (create! {:conn *conn*} (scm {:scm2 (scm2 {:val1 22})})) 239 | (let [soe (create! {:conn *conn*} 240 | (scmownsenum {:enum (scm2 {:val1 42})}))] 241 | (is (= (let [si (:enum soe)] 242 | (q :find :ScmOwnsEnum :in (db) :where 243 | [% {:enum si}])) 244 | (q :find :ScmOwnsEnum :in (db) :where 245 | [% {:enum (:enum soe)}]) 246 | #{[soe]}) 247 | "can pull db-ref out of object if it exists"))) 248 | (with-test-db simple-schema 249 | (create! {:conn *conn*} (ferret {:name "catsnake"})) 250 | (create! {:conn *conn*} (mouse {:name "zuzu"})) 251 | (is (refless= (q :find :Animal :in (db) :where 252 | [% {:name "zuzu"}]) 253 | #{[(mouse {:name "zuzu"})]})) 254 | (create! {:conn *conn*} (mouse {:name "catsnake"})) 255 | (is (refless= (q :find [:Animal ...] :in (db) :where 256 | [% {:name "catsnake"}]) 257 | #{(mouse {:name "catsnake"}) 258 | (ferret {:name "catsnake"})})))) 259 | 260 | (deftest test-q-bad-data 261 | (with-test-db simple-schema 262 | (is (thrown-with-msg? 263 | clojure.lang.ExceptionInfo #"nil" 264 | (let [nil-val nil] (q :find :Scm :in (db) :where [% {:val1 nil-val}]))) 265 | "having a runtime nil in a map gets caught before Datomic") 266 | 267 | (let [id (get-in (create! {:conn *conn*} (scm {:val1 "baz"})) [:db-ref :eid])] 268 | (assert @(d/transact *conn* [[':db/add id :scm/scm2 123]])) 269 | (is (= id (ffirst (d/q '[:find ?scm :in $ :where [?scm :scm/scm2 123]] (db)))) 270 | "insertion of bad scm2 ref should work") 271 | 272 | (is (thrown-with-msg? 273 | clojure.lang.ExceptionInfo #"bad entity in database" 274 | (:scm2 (recursive-ctor :Scm (d/entity (db) id)))) 275 | "cant get an Scm2 out of it") 276 | 277 | (assert @(d/transact *conn* 278 | [{:db/id (d/tempid :db.part/user -100) 279 | :spec-tacular/spec :Scm2 280 | :scm/val1 "5"} 281 | [:db/add id :scm/scm2 (d/tempid :db.part/user -100)]])) 282 | 283 | (is (thrown? clojure.lang.ExceptionInfo 284 | (q :find :Scm2 :in (db) :where [:Scm {:scm2 %}]))) 285 | ))) 286 | 287 | (deftest test-q-pull 288 | (with-test-db simple-schema 289 | (let [spotlight (create! {:conn *conn*} (spotlight {:color :LenseColor/red}))] 290 | (is (= (q :find (pull :Spotlight [:color]) . 291 | :in (db) 292 | :where 293 | [% {:color :LenseColor/red}]) 294 | {:color :LenseColor/red})) 295 | (is (= (q :find (pull :Spotlight [:color]) 296 | :in (db) 297 | :where 298 | [% {:color :LenseColor/red}]) 299 | #{[{:color :LenseColor/red}]})) 300 | (is (= (q :find [(pull :Spotlight [:color]) ...] 301 | :in (db) 302 | :where 303 | [% {:color :LenseColor/red}]) 304 | #{{:color :LenseColor/red}})) 305 | (is (= (q :find [(pull :Spotlight [:color]) :LenseColor] 306 | :in (db) 307 | :where 308 | [%1 {:color %2}]) 309 | [{:color :LenseColor/red} :LenseColor/red])) 310 | ))) 311 | 312 | (deftest test-q-aggregate 313 | (with-test-db simple-schema 314 | (let [ex (create! {:conn *conn*} (scm {:val1 "123" :val2 123})) 315 | ey (create! {:conn *conn*} (scm {:val1 "456" :val2 456}))] 316 | (is (= (q :find (min :long) 317 | :in (db) 318 | :where 319 | [:Scm {:val2 ?val2}] 320 | [(- ?val2 5) %]) 321 | #{[118]})))) 322 | (with-test-db simple-schema 323 | (let [ex (create! {:conn *conn*} (scm {:val1 "123" :val2 123})) 324 | ey (create! {:conn *conn*} (scm {:val1 "456" :val2 456}))] 325 | (is (= (q :find (spark.spec-tacular.datomic.query-test/ex-aggregate :long) . 326 | :in (db) 327 | :where 328 | [:Scm {:val2 ?val2}] 329 | [(- ?val2 5) %1]) 330 | 5))))) 331 | 332 | (deftest test-q-or-and 333 | (with-test-db simple-schema 334 | (let [ex (create! {:conn *conn*} (scm {:val2 6}))] 335 | (is (= (q :find [:Scm ?kw] :in (db) :where 336 | (or (and [% {:val2 5}] 337 | [(ground :five) ?kw]) 338 | (and [% {:val2 6}] 339 | [(ground :six) ?kw]))) 340 | [ex :six]))))) 341 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/grammar_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.grammar-test 2 | (:use clojure.test) 3 | (:require [spark.spec-tacular.grammar :refer :all])) 4 | 5 | (deftest test-valid-syntax 6 | (testing "spec" 7 | (let [spec (parse-spec '(Link 8 | (:link 9 | [a :is-a :A] 10 | [b :is-many :B]) 11 | [c :is-a :C :required] 12 | [d :is-many :D]))] 13 | (is (= (:name spec) :Link)) 14 | (is (= (:opts spec) nil)) 15 | (is (= (:items spec) 16 | [#spark.spec_tacular.spec.Item{:name :a, :type [:one :A],:precondition nil, 17 | :required? nil,:unique? nil,:optional? nil, 18 | :identity? nil, :default-value nil, :link? true} 19 | #spark.spec_tacular.spec.Item{:name :b, :type [:many :B], :precondition nil, 20 | :required? nil, :unique? nil, :optional? nil, 21 | :identity? nil, :default-value nil, :link? true} 22 | #spark.spec_tacular.spec.Item{:name :c, :type [:one :C], :precondition nil, 23 | :required? true, :unique? nil, :optional? nil, 24 | :identity? nil, :default-value nil} 25 | #spark.spec_tacular.spec.Item{:name :d, :type [:many :D], :precondition nil, 26 | :required? nil, :unique? nil, :optional? nil, 27 | :identity? nil, :default-value nil}])))) 28 | 29 | (testing "union" 30 | (is (= (parse-union '(Foo :Bar :Baz)) 31 | #spark.spec_tacular.spec.UnionSpec{:name :Foo, :elements #{:Baz :Bar}}))) 32 | 33 | (testing "enum" 34 | (is (= (parse-enum '(Foo Bar Baz)) 35 | #spark.spec_tacular.spec.EnumSpec{:name :Foo, :values #{:Foo/Bar, :Foo/Baz}})) 36 | 37 | (is (= (:items (parse-spec '(HasEnum [word :is-a :IsEnum]))) 38 | [#spark.spec_tacular.spec.Item{:name :word, :type [:one :IsEnum]}])))) 39 | 40 | (deftest test-invalid-syntax 41 | (testing "spec" 42 | (is (thrown? clojure.lang.ExceptionInfo 43 | (parse-spec '(Foo [nonsense :nonsense])))) 44 | 45 | (is (thrown? clojure.lang.ExceptionInfo 46 | (parse-spec '(Foo [nonsense :is-a :string :nonsense])))) 47 | 48 | (is (thrown? clojure.lang.ExceptionInfo 49 | (parse-spec '(Foo :nonsense)))) 50 | 51 | (is (thrown? clojure.lang.ExceptionInfo 52 | (parse-spec '(Person [name :is-a string])))) 53 | 54 | #_(is (thrown? clojure.lang.ExceptionInfo ;; TODO 55 | (parse-spec '(Foo [bar :is-a :Bar] [bar :is-a :Bar])))) 56 | 57 | (is (thrown? clojure.lang.ExceptionInfo 58 | (parse-spec '(Container [one :is-a :Container :link :component]))))) 59 | 60 | (testing "union" 61 | #_(is (thrown? clojure.lang.ExceptionInfo ;; TODO 62 | (parse-union '(Foo 5))))) 63 | 64 | (testing "enum" 65 | (is (thrown? clojure.lang.ExceptionInfo (parse-enum '(Foo :bar)))) 66 | (is (thrown? clojure.lang.ExceptionInfo (parse-enum '(:Foo :bar)))) 67 | (is (thrown? clojure.lang.ExceptionInfo (parse-enum '(Foo)))) 68 | (is (thrown? clojure.lang.ExceptionInfo (parse-enum '()))))) 69 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/meta_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.meta-test 2 | {:core.typed {:collect-only true} 3 | :spec-tacular {:ctor-name-fn '(fn [s] (str "mk-" (clojure.string/upper-case s))) 4 | :huh-name-fn '(fn [s] (str (clojure.string/upper-case s) "?")) 5 | :alias-name-fn '(fn [s] (clojure.string/upper-case s))}} 6 | (:require [spark.spec-tacular :refer :all] 7 | [clojure.test :refer :all] 8 | [clojure.core.typed :as t])) 9 | 10 | (defspec Keyboard 11 | [type :is-a :KeyboardVendor] 12 | [warranty :is-a :KeyboardWarranty]) 13 | 14 | (defunion KeyboardWarranty 15 | :TwoYearsNoRepairs 16 | :FiveYearsPartsLabor) 17 | 18 | (defspec TwoYearsNoRepairs) 19 | (defspec 20 | ^{:ctor-name "BestDeal" 21 | :huh-name false ;; fall back to default 22 | :alias-name "TwelveYearsDungeon"} 23 | FiveYearsPartsLabor 24 | [company :is-a :string]) 25 | 26 | (defenum KeyboardVendor 27 | Razer TrulyErgonomic Das Kinesis) 28 | 29 | (deftest test-caps-lock-key-got-stuck 30 | (testing "ctor-name" 31 | (is mk-KEYBOARD) 32 | (is mk-TWOYEARSNOREPAIRS) 33 | (is BestDeal)) 34 | 35 | (testing "huh-name" 36 | (is (KEYBOARD? (mk-KEYBOARD {}))) 37 | (is (KEYBOARDWARRANTY? (mk-TWOYEARSNOREPAIRS {}))) 38 | (is (KEYBOARDWARRANTY? (BestDeal {}))) 39 | (is (fiveyearspartslabor? (BestDeal {}))) 40 | (is (KEYBOARDVENDOR? :KeyboardVendor/Razer)) 41 | (is (KEYBOARDVENDOR? :KeyboardVendor/Kinesis)))) 42 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/readme_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.readme-test 2 | (:refer-clojure :exclude [cat]) 3 | (:use clojure.test) 4 | (:require [spark.spec-tacular.schema :as schema] 5 | [spark.spec-tacular.datomic :as sd] 6 | [spark.spec-tacular :as sp :refer [defspec defunion defenum]])) 7 | 8 | ;; Sets up a House entity containing a mandantory color and optionally 9 | ;; a Mailbox. It may also link in any number of Occupants. 10 | (defspec House 11 | (:link [occupants :is-many :Occupant]) 12 | [mailbox :is-a :Mailbox] 13 | [color :is-a :Color :required]) 14 | 15 | (defenum Color 16 | green, orange) 17 | 18 | (defspec Mailbox 19 | [has-mail? :is-a :boolean]) 20 | 21 | ;; Houses can be occupied by either People or Pets. 22 | (defunion Occupant :Person :Pet) 23 | 24 | ;; Each Person has a name that serves as an identifying field 25 | ;; (implemented as Datomic's notion of identity), and an age. 26 | (defspec Person 27 | [name :is-a :string :identity :unique] 28 | [age :is-a :long]) 29 | 30 | (defunion Pet :Dog :Cat :Porcupine) 31 | 32 | (defspec Dog 33 | [fleas? :is-a :boolean]) 34 | 35 | ;; Cats can contain links (passed by reference to the database) to all 36 | ;; the occupants of the house that they hate. For their nefarious 37 | ;; plots, no doubt. 38 | (defspec Cat 39 | [hates :is-many :Occupant :link]) 40 | 41 | (defspec Porcupine) ;; No fields, porcupines are boring 42 | 43 | ;;; Creating Databases 44 | 45 | (deftest test-readme-creating-databases 46 | (is (every? map? (schema/from-namespace *ns*))) 47 | (is (instance? datomic.peer.LocalConnection (schema/to-database! (schema/from-namespace *ns*))))) 48 | 49 | (deftest test-readme-interfacing-databases 50 | 51 | ;; Use the House schema to create a database and connection 52 | (def conn-ctx {:conn (schema/to-database! (schema/from-namespace 'spark.spec-tacular.readme-test))}) 53 | (def h (sd/create! conn-ctx (house {:color :Color/green}))) 54 | 55 | ;; Some quick semantics: 56 | (is (= (:color h) :Color/green)) 57 | (is (= (= h (house {:color :Color/green})) false)) 58 | (is (= (sp/refless= h (house {:color :Color/green})) true)) 59 | (is (thrown-with-msg? clojure.lang.ExceptionInfo #"field" 60 | (assoc h :random-kw 42))) 61 | (is (= (set [h h]) #{h})) 62 | (is (= (set [h (house {:color :Color/green})]) #{h (house {:color :Color/green})})) 63 | 64 | (def joe (sd/create! conn-ctx (person {:name "Joe" :age 32}))) 65 | (def bernard (sd/create! conn-ctx (person {:name "Bernard" :age 25}))) 66 | 67 | (def new-h (sd/assoc! conn-ctx h :occupants [joe bernard])) 68 | 69 | (is (= (sp/refless= h (house {:color :Color/green})) true)) 70 | (is (= (sd/refresh conn-ctx h) new-h)) 71 | 72 | (def zuzu (sd/create! conn-ctx (cat {:hates (:occupants new-h)}))) 73 | (sd/assoc! conn-ctx h :occupants (conj (:occupants new-h) zuzu)) 74 | 75 | (let [mb (mailbox {:has-mail? false}) 76 | h1 (sd/assoc! conn-ctx h :mailbox mb) 77 | h2 (sd/create! conn-ctx (house {:color :Color/orange :mailbox mb}))] 78 | ;; But since Mailboxes are passed by value, 79 | ;; the Mailbox get duplicated 80 | (is (= (= (:mailbox h1) (:mailbox h2)) false)) 81 | 82 | (def mb1 (sd/assoc! conn-ctx (:mailbox h1) :has-mail? true)) 83 | (def db (sd/db conn-ctx)) 84 | (is (= (sd/q :find [:Mailbox ...] :in db :where [% {:has-mail? false}]) #{(:mailbox h2)})) 85 | (is (= (sd/q :find [:Mailbox ...] :in db :where [% {:has-mail? true}]) #{mb1})) 86 | (is (= (sd/q :find [:House ...] :in db :where 87 | [% {:mailbox {:has-mail? false}}]) 88 | #{h2})) 89 | (is (= (sd/q :find :House, :Person :in db :where 90 | [%1 {:occupants %2 :mailbox {:has-mail? true}}]) 91 | #{[(sd/refresh conn-ctx h1) joe] [(sd/refresh conn-ctx h1) bernard]})) 92 | (is (= (sd/q :find [:string ...] :in db :where 93 | [:House {:occupants [:Person {:name %}]}]) 94 | #{"Joe" "Bernard"})))) 95 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/schema_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.schema-test 2 | (:refer-clojure :exclude [read-string read]) 3 | (:use clojure.test 4 | spark.spec-tacular.spec 5 | [spark.spec-tacular :exclude [diff]] 6 | spark.spec-tacular.schema 7 | spark.spec-tacular.test-utils) 8 | (:require [datomic.api :as d] 9 | [clojure.java.io :as io] 10 | [spark.spec-tacular-test :as spt])) 11 | 12 | ;;;; check tests 13 | 14 | (def schema 15 | [{:db/id 123124 16 | :db/ident :exspec/var1 17 | :db/unique :db.unique/identity 18 | :db/valueType :db.type/string} 19 | spec-tacular-map]) 20 | 21 | (def schema-by-value 22 | [{:db/id 123124 23 | :db/ident :exspec/var1 24 | :db/unique :db.unique/value 25 | :db/valueType :db.type/string} 26 | spec-tacular-map]) 27 | 28 | (def schema-alt-keys 29 | [{:db/id 123124 30 | :db/ident :exspec/var2 31 | :db/valueType :db.type/string} 32 | spec-tacular-map]) 33 | 34 | (def matching-spec 35 | (map->Spec 36 | {:name 'exspec 37 | :items 38 | (map map->Item 39 | [{:name :var1 :type [:one String] :identity? true :unique? true}])})) 40 | 41 | (def not-matching-spec 42 | (map->Spec 43 | {:name 'exspec 44 | :items 45 | (map map->Item 46 | [{:name :var1 :type [:one String]}])})) 47 | 48 | (defspec ExSpec 49 | [var1 :is-a :string :unique]) 50 | 51 | (deftest test-check 52 | (is (empty? (check schema matching-spec))) 53 | (is (= '("uniqueness for field :var1 in exspec is inconsistant") 54 | (check schema not-matching-spec))) 55 | (is (= '("uniqueness for field :var1 in exspec is inconsistant") 56 | (check schema-by-value matching-spec))) 57 | (is (= '("inconsistent keys between schema and spec. Diff: [#{:var2} #{:var1} nil]") 58 | (check schema-alt-keys matching-spec)))) 59 | 60 | (defspec P 61 | [name :is-a :string]) 62 | 63 | (defspec Abode 64 | [occupants :is-many :P]) 65 | 66 | (deftest test-schema-write 67 | (let [schema (from-specs [:P])] 68 | (check schema (get-spec :P)) 69 | (let [s (with-out-str (write schema *out*))] 70 | (is (= (re-seq #":db/ident [^,}]*" s) 71 | [":db/ident :spec-tacular/spec" 72 | ":db/ident :p/name"])) 73 | (is (= (re-seq #":db/cardinality :db.cardinality/[^,}]*" s) 74 | [":db/cardinality :db.cardinality/one" 75 | ":db/cardinality :db.cardinality/one"])) 76 | (is (= (re-seq #":db/valueType :db.type/[^,}]*" s) 77 | [":db/valueType :db.type/keyword" 78 | ":db/valueType :db.type/string"]))))) 79 | 80 | (deftest test-normalize 81 | (let [schema (from-specs [:P :Abode]) 82 | clean-schema (normalize schema) 83 | dirty-schema (normalize (from-database (to-database! schema)))] 84 | (is (every? #(and (contains? % :db/ident) 85 | (contains? % :db/valueType) 86 | (contains? % :db/cardinality) 87 | (contains? % :db/unique) 88 | (contains? % :db/doc) 89 | (= (count %) 5)) 90 | dirty-schema) 91 | "checks that normalized schemas only contain the fields 92 | we use for comparison between schema and spec") 93 | (is (= clean-schema dirty-schema)))) 94 | 95 | (deftest test-delta 96 | (let [old [{:db/ident :foo}] 97 | new [{:db/ident :foo} {:db/ident :bar}]] 98 | (is (= (delta old new) [{:db/ident :bar}]) 99 | "adding a new entry to schema")) 100 | 101 | (let [old [{:db/ident :foo}] 102 | new []] 103 | (is (thrown-with-msg? clojure.lang.ExceptionInfo 104 | #"Deletion and renaming not supported" 105 | (delta old new)) 106 | "removing an entry from schema"))) 107 | 108 | (defspec Birthday 109 | [date :is-a :calendarday :doc "birthday date"]) 110 | 111 | (def ns-schema (from-namespace *ns*)) 112 | 113 | (deftest test-from-namespace 114 | (let [[missing extra both] 115 | (diff [{:db/ident :p/name, 116 | :db/valueType :db.type/string, 117 | :db/cardinality :db.cardinality/one, 118 | :db/doc "", 119 | :db.install/_attribute :db.part/db} 120 | {:db/unique :db.unique/value, 121 | :db/ident :exspec/var1, 122 | :db/valueType :db.type/string, 123 | :db/cardinality :db.cardinality/one, 124 | :db/doc "", 125 | :db.install/_attribute :db.part/db} 126 | {:db/ident :abode/occupants, 127 | :db/valueType :db.type/ref, 128 | :db/cardinality :db.cardinality/many, 129 | :db/doc "", 130 | :db.install/_attribute :db.part/db} 131 | {:db/ident :birthday/date, 132 | :db/valueType :db.type/instant, 133 | :db/cardinality :db.cardinality/one, 134 | :db/doc "birthday date"}] 135 | ns-schema)] 136 | (is (nil? missing) "no missing entries") 137 | (is (nil? extra) "no extra entries"))) 138 | 139 | (deftest test-enums 140 | (is (= (set (normalize (from-specs [spt/IsEnum spt/HasEnum]))) 141 | #{{:db/unique nil, 142 | :db/ident :hasenum/word, 143 | :db/valueType :db.type/ref, 144 | :db/cardinality :db.cardinality/one, 145 | :db/doc ""} 146 | {:db/unique nil, 147 | :db/ident :hasenum/words, 148 | :db/valueType :db.type/ref, 149 | :db/cardinality :db.cardinality/many, 150 | :db/doc ""} 151 | {:db/ident :IsEnum/how, 152 | :db/unique nil} 153 | {:db/ident :IsEnum/now, 154 | :db/unique nil} 155 | {:db/ident :IsEnum/brown, 156 | :db/unique nil} 157 | {:db/ident :IsEnum/cow, 158 | :db/unique nil}}))) 159 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/test_specs.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.test-specs 2 | {:core.typed {:collect-only true}} 3 | (:require [clojure.core.typed :as t]) 4 | (:use spark.spec-tacular)) 5 | 6 | (defspec Scm2 7 | [val1 :is-a :long]) 8 | 9 | (defspec Scm 10 | [val1 :is-a :string :unique :identity] 11 | [val2 :is-a :long] 12 | [multi :is-many :string] 13 | (:link 14 | [scm2 :is-a :Scm2])) 15 | 16 | (defspec Scm3) 17 | 18 | (defunion ScmEnum :Scm2 :Scm3 :Scm) 19 | 20 | (defspec ScmOwnsEnum 21 | (:link 22 | [enum :is-a :ScmEnum] 23 | [enums :is-many :ScmEnum])) 24 | 25 | (defspec ScmM 26 | [identity :is-a :string :unique :identity] 27 | (:link [val :is-a :ScmEnum]) 28 | (:link [vals :is-many :Scm2])) 29 | 30 | (defspec ScmParent 31 | (:link [scm :is-a :Scm])) 32 | 33 | (defspec ScmReq 34 | [name :is-a :string :required]) 35 | 36 | (defspec ScmLink 37 | (:link 38 | [link1 :is-a :Scm] 39 | [link2 :is-many :Scm2]) 40 | [val1 :is-a :ScmParent]) 41 | 42 | (defspec ScmMWrap 43 | [name :is-a :string] 44 | (:link [val :is-a :ScmM])) 45 | 46 | (defspec ScmKw 47 | [item :is-a :keyword]) 48 | 49 | (defspec Ferret 50 | [name :is-a :string]) 51 | 52 | (defspec Mouse 53 | [name :is-a :string]) 54 | 55 | (defunion Animal :Ferret :Mouse) 56 | 57 | (defspec Birthday 58 | [date :is-a :calendarday]) 59 | 60 | (defspec Container 61 | [number :is-a :long] 62 | [one :is-a :Container :component] 63 | [many :is-many :Container :component]) 64 | 65 | (defenum LenseColor 66 | red blue green orange) 67 | 68 | (defspec Spotlight 69 | [color :is-a :LenseColor] 70 | [shaders :is-many :LenseColor]) 71 | 72 | (defspec Switch 73 | [on? :is-a :boolean]) 74 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/test_utils.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.test-utils 2 | (:require [datomic.api :as db] 3 | [spark.spec-tacular.datomic :refer [spark-type-attr]])) 4 | 5 | ;;;; Macro for using fresh datomic instances for every test. 6 | 7 | (def ^:dynamic *conn*) 8 | (defn db [] (db/db *conn*)) 9 | (defn uri [] (str "datomic:mem://" (gensym "temporary-database"))) 10 | 11 | (defn make-db [schema] 12 | (let [uri (uri), db (db/create-database uri), c (db/connect uri)] 13 | @(db/transact c schema) 14 | c)) 15 | 16 | (defmacro with-test-db [schema & body] 17 | `(binding [*conn* (make-db ~schema)] 18 | ~@body)) 19 | -------------------------------------------------------------------------------- /test/spark/spec_tacular/typecheck_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular.typecheck-test 2 | (:use clojure.test) 3 | (:require [spark.spec-tacular] 4 | [spark.spec-tacular.datomic :as sd] 5 | [spark.spec-tacular.test-specs :as ts] 6 | [clojure.core.typed :as t])) 7 | 8 | (t/typed-deps spark.spec-tacular 9 | spark.spec-tacular.datomic 10 | spark.spec-tacular.test-specs) 11 | 12 | (t/ann test-query-typecheck [sd/Database -> (t/Set (t/HVec [Long]))]) 13 | (defn test-query-typecheck 14 | "not a runtime unit test: but included in typechecking phase" 15 | [db] 16 | (sd/q :find ?a :in db :where [:Scm2 {:val1 ?a}])) 17 | 18 | (t/ann test-multi-query-typecheck [sd/Database -> (t/Set (t/HVec [String Long]))]) 19 | (defn test-multi-query-typecheck 20 | "not a runtime unit test: but included in typechecking phase" 21 | [db] 22 | (sd/q :find ?a ?b :in db :where [:Scm {:val1 ?a :val2 ?b}])) 23 | 24 | (t/ann test-coll-query-typecheck [sd/Database -> (t/Set String)]) 25 | (defn test-coll-query-typecheck [db] 26 | (sd/q :find [?a ...] :in db :where [:Scm {:val1 ?a}])) 27 | 28 | (t/ann test-is-multi-set ts/Scm) 29 | (def test-is-multi-vec 30 | (ts/scm {:multi #{"hi"}})) 31 | 32 | (t/ann test-coll-spec [sd/Database -> (t/Option ts/ScmEnum)]) 33 | (defn test-coll-spec [db] 34 | (-> (sd/q :find [:ScmOwnsEnum ...] :in db :where 35 | [% {:enum :Scm}]) 36 | first :enum)) 37 | 38 | (t/ann test-get-all-by-spec-scmenum [sd/Database -> (t/ASeq ts/ScmEnum)]) 39 | (defn test-get-all-by-spec-scmenum [db] 40 | (sd/get-all-by-spec db :ScmEnum)) 41 | 42 | (t/ann test-huh [t/Any -> t/Bool]) 43 | (defn test-huh [x] 44 | (or (ts/scm? x) 45 | (ts/scmownsenum? x) 46 | (ts/animal? x) 47 | (ts/lensecolor? x))) 48 | 49 | (t/ann ex-color ts/LenseColor) 50 | (def ex-color :LenseColor/red) 51 | 52 | (t/ann ex-spotlights (t/Vec ts/Spotlight)) 53 | (def ex-spotlights 54 | [(ts/spotlight {}) 55 | (ts/spotlight {:color :LenseColor/red}) 56 | (ts/spotlight {:color :LenseColor/green 57 | :shaders #{:LenseColor/orange}})]) 58 | 59 | (t/ann test-color-enum [sd/Database -> (t/Set ts/LenseColor)]) 60 | (defn test-color-enum [db] 61 | (sd/q :find [:LenseColor ...] :in db :where 62 | [:Spotlight {:color %}] 63 | [:Spotlight {:shaders %}])) 64 | -------------------------------------------------------------------------------- /test/spark/spec_tacular_test.clj: -------------------------------------------------------------------------------- 1 | (ns spark.spec-tacular-test 2 | (:use spark.spec-tacular 3 | clojure.test 4 | [spark.spec-tacular.generators :exclude [prop-check-components]]) 5 | (:require [clojure.core.typed :as t] 6 | [clojure.test.check :as tc] 7 | [clojure.test.check.generators :as gen] 8 | [clojure.test.check.properties :as prop] 9 | [clojure.test.check.clojure-test :as ct])) 10 | 11 | ;; ----------------------------------------------------------------------------- 12 | ;; defspec 13 | 14 | (defspec TestSpec1 15 | [val1 :is-a :long :required] 16 | [val2 :is-a :string] 17 | [val3 :is-a :long :default-value 3] 18 | [val4 :is-a :keyword :default-value (fn [] :val)] 19 | [val5 :is-a :TestSpec3]) 20 | 21 | (deftest test-TestSpec1 22 | (testing "valid" 23 | (is (some? (get-spec :TestSpec1))) 24 | (is (some? (get-spec :TestSpec1 :TestSpec1))) 25 | (is (some? (get-spec {:spec-tacular/spec :TestSpec1}))) 26 | (is (some? (get-spec (get-spec :TestSpec1)))) 27 | 28 | (let [good (testspec1 {:val1 3 :val2 "hi"})] 29 | (is (testspec1? good)) 30 | (is (= (:val1 good) 3)) 31 | (is (= (:val2 good) "hi")) 32 | (is (= (:val3 good) 3)) 33 | (is (= (:val4 good) :val)) 34 | 35 | (is (= (keys good) [:val1 :val2 :val3 :val4])) 36 | 37 | (testing "has-spec?" 38 | (is (has-spec? good)) 39 | (is (not (has-spec? 5))))) 40 | 41 | (is (= (count (into #{} [(testspec1 {:val1 5}) (testspec1 {:val1 5})])) 1))) 42 | 43 | (testing "invalid" 44 | (is (not (testspec1? {:val1 3 :val2 "hi"})) 45 | "not a record") 46 | (is (thrown-with-msg? clojure.lang.ExceptionInfo #"required" 47 | (testspec1 {:val1 nil})) 48 | "missing required field") 49 | (is (thrown-with-msg? clojure.lang.ExceptionInfo #"required" 50 | (testspec1 {:val2 1})) 51 | "missing required field") 52 | (is (thrown-with-msg? clojure.lang.ExceptionInfo #"invalid type" 53 | (testspec1 {:val1 0 :val2 1})) 54 | "wrong type") 55 | (is (thrown? clojure.lang.ExceptionInfo (testspec1 {:val1 3 :extra-key true})) 56 | "extra key"))) 57 | 58 | ;; ----------------------------------------------------------------------------- 59 | ;; link 60 | 61 | (defspec TestSpec2 62 | (:link [ts1 :is-a :TestSpec1])) 63 | (defspec TestSpec3) 64 | 65 | (deftest test-TestSpec2 66 | (is (doall (testspec2 {:ts1 (testspec1 {:val1 42})}))) 67 | 68 | (testing "order of spec definition does not matter" 69 | (is (testspec1? (testspec1 {:val1 1 :val5 (testspec3)})))) 70 | 71 | (testing "links are not checked" 72 | (let [ts1 (i_TestSpec1. {::bad-key true} (atom {}) nil)] 73 | (is (testspec2 {:ts1 ts1}))))) 74 | 75 | ;; ----------------------------------------------------------------------------- 76 | ;; booleans, is-many 77 | 78 | (defspec TestSpec4 79 | [val1 :is-a :boolean] 80 | [val2 :is-many :boolean]) 81 | 82 | (deftest test-TestSpec4 83 | (testing "booleans" 84 | (is (some? (check-component! (get-spec :TestSpec4) :val1 false))) 85 | (is (testspec4? (testspec4 {:val1 false}))) 86 | (is (some? (re-find #"false" (pr-str (testspec4 {:val1 false}))))))) 87 | 88 | ;; ----------------------------------------------------------------------------- 89 | ;; required 90 | 91 | (defspec TestSpec5 92 | [name :is-a :string :required]) 93 | 94 | (deftest test-TestSpec5 95 | (testing "empty string" 96 | (is (some? (check-component! (get-spec :TestSpec5) :name ""))))) 97 | 98 | ;; ----------------------------------------------------------------------------- 99 | ;; forward references 100 | 101 | (defspec A [b :is-a :B]) 102 | (defspec B [a :is-a :A]) 103 | 104 | ;; ----------------------------------------------------------------------------- 105 | ;; unions 106 | 107 | (defunion testunion :TestSpec2 :TestSpec3) 108 | (defspec ES [foo :is-a :testunion]) 109 | (defspec ESParent [es :is-a :ES]) 110 | 111 | (deftest test-defunion 112 | (is (some? (get-spec :testunion))) 113 | (is (= (get-spec :testunion {:spec-tacular/spec :TestSpec2}) 114 | (get-spec :TestSpec2))) 115 | (is (= (:elements (get-spec :testunion)) 116 | #{:TestSpec2 :TestSpec3})) 117 | 118 | (is (testunion? (testspec2 {}))) 119 | (is (instance? spark.spec_tacular.spec.UnionSpec (get-spec :testunion))) 120 | (is (check-component! (get-spec :ES) :foo (testspec2 {}))) 121 | (is (thrown? clojure.lang.ExceptionInfo (check-component! (get-spec :ES) :foo :nope))) 122 | (is (thrown? clojure.lang.ExceptionInfo (es (testspec1 {:val1 1})))) 123 | (is (thrown? clojure.lang.ExceptionInfo (get-spec :testunion (testspec1 {:val1 1})))) 124 | (is (thrown? clojure.lang.ExceptionInfo (esparent {:es {:foo (testspec1 {:val1 1})}}))) 125 | (is (thrown? clojure.lang.ExceptionInfo (es {:foo (a {})})))) 126 | 127 | (defunion UnionFoo :UnionForward) 128 | (defspec UnionForward) 129 | 130 | (defspec TestSpec6 131 | [union :is-many :UnionFoo]) 132 | 133 | ;; ----------------------------------------------------------------------------- 134 | ;; enums 135 | 136 | (defenum IsEnum how now brown cow) 137 | (defspec HasEnum 138 | [word :is-a :IsEnum] 139 | [words :is-many :IsEnum]) 140 | 141 | (deftest test-defenum 142 | (is (isenum? :IsEnum/how)) 143 | (is (isenum? :IsEnum/cow)) 144 | 145 | (is (= (get-spec :IsEnum) 146 | (get-spec :IsEnum/how) 147 | IsEnum)) 148 | 149 | (is (hasenum {:word :IsEnum/how})) 150 | (is (hasenum? (hasenum {:word :IsEnum/now}))) 151 | (is (isenum? (:word (hasenum {:word :IsEnum/brown})))) 152 | (is (every? isenum? (:words (hasenum {:words #{:IsEnum/how :IsEnum/cow}}))))) 153 | 154 | ;; ----------------------------------------------------------------------------- 155 | ;; complex 156 | 157 | (defspec Link 158 | (:link 159 | [ts1 :is-a :TestSpec1] 160 | [ts2 :is-many :TestSpec2]) 161 | [ts3 :is-a :TestSpec3] 162 | [ts4 :is-many :TestSpec4] 163 | [s1 :is-many :string]) 164 | 165 | (deftest test-refless= 166 | (is (refless= #{false} #{false})) 167 | (is (refless= #{nil} #{nil}))) 168 | 169 | (deftest test-link 170 | (let [many [(testspec2) (testspec2 {:ts1 (testspec1 {:val1 42})})] 171 | l (link {:ts1 (testspec1 {:val1 42}) 172 | :ts2 many 173 | :ts3 (testspec3) 174 | :ts4 [(testspec4 {:val1 false})]})] 175 | (is (link? l)) 176 | (is (thrown-with-msg? clojure.lang.ExceptionInfo #"not a map" 177 | (recursive-ctor :TestSpec2 many))) 178 | (is (= (:ts2 l) (set many))) 179 | (is (doall (with-out-str (prn l))))) 180 | 181 | (let [l (link {:s1 ["a" "b" "c"]})] 182 | (is (link? l))) 183 | 184 | (let [l (link {:ts3 nil})] 185 | (is (link? l)) 186 | (is (not (:ts3 l)))) 187 | 188 | (let [l1 (link {:ts3 (assoc (testspec3) :db-ref 1)})] 189 | (is (= (refless l1) 190 | (link {:ts3 (testspec3)})))) 191 | 192 | (let [l1 (link {:ts3 (testspec3 {:db-ref 1}) :db-ref 3}) 193 | l2 (link {:ts3 (testspec3 {:db-ref 2}) :db-ref 4})] 194 | (is (refless= [[[l1]]] [[[l2]]]) "refless equality")) 195 | 196 | (testing "is-many" 197 | (is (not= (link {:ts4 [(testspec4 {:val1 true}) (testspec4 {:val1 false})]}) 198 | (link {:ts4 [(testspec4 {:val1 true}) (testspec4 {:val1 true})]}))) 199 | (is (not= (link {:ts4 [(testspec4 {:val1 true}) (testspec4 {:val1 true})]}) 200 | (link {:ts4 [(testspec4 {:val1 true}) (testspec4 {:val1 false})]}))))) 201 | 202 | (defspec TestSpec7 203 | [nums :is-many :long]) 204 | 205 | (deftest test-is-many 206 | (is (= (testspec7 {:nums [1 2 3 4]}) 207 | (testspec7 {:nums #{1 2 3 4}})))) 208 | 209 | (defspec TestSpec8 210 | [day :is-a :calendarday]) 211 | 212 | (deftest test-calendarday 213 | (is (= (:day (assoc (testspec8) :day "2015-1-1")) 214 | (clj-time.core/date-time 2015 1 1)))) 215 | 216 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 217 | ;; random testing 218 | 219 | (defn prop-check-components 220 | "property for verifying that check-component!, create!, and update! work correctly" 221 | [spec-key] 222 | (let [sp-gen (mk-spec-generator spec-key) 223 | spec (get-spec spec-key) 224 | gen (gen/bind sp-gen gen/return) 225 | fields (map :name (:items spec))] 226 | (prop/for-all [instance gen] 227 | (and (every? #(check-component! spec % (get instance %)) fields) 228 | (do (with-out-str (prn instance)) true))))) 229 | 230 | (ct/defspec gen-TestSpec3 100 (prop-check-components :TestSpec3)) 231 | (ct/defspec gen-TestSpec1 100 (prop-check-components :TestSpec1)) 232 | (ct/defspec gen-TestSpec2 100 (prop-check-components :TestSpec2)) 233 | (ct/defspec gen-TestSpec4 100 (prop-check-components :TestSpec4)) 234 | (ct/defspec gen-TestSpec5 100 (prop-check-components :TestSpec5)) 235 | (ct/defspec gen-testunion 100 (prop-check-components :testunion)) 236 | (ct/defspec gen-ES 100 (prop-check-components :ES)) 237 | (ct/defspec gen-ESParent 100 (prop-check-components :ESParent)) 238 | (ct/defspec gen-TestSpec6 100 (prop-check-components :TestSpec6)) 239 | (ct/defspec gen-Link 100 (prop-check-components :Link)) 240 | (ct/defspec gen-HasEnum 100 (prop-check-components :HasEnum)) 241 | 242 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 243 | ;; diff 244 | 245 | (defspec Human 246 | [name :is-a :string] 247 | [age :is-a :long] 248 | [pets :is-many :Animal]) 249 | 250 | (deftest test-diff 251 | (let [peter (human {:name "Peter" :age 17}) 252 | paul (human {:name "Paul" :age 18}) 253 | #_mary #_(human {:name "Mary" :age 18 :pets [(dog {:name "George"}) (cat {:name "Ringo"})]})] 254 | (is (= (diff peter paul) 255 | [{:name "Peter" :age 17} {:name "Paul" :age 18} {}])) 256 | (is (= (diff peter (human {:name "Peter" :age 25})) 257 | [{:age 17} {:age 25} {:name "Peter"}])) 258 | (is (= (diff peter (human {:age 25})) 259 | [{:name "Peter" :age 17} {:age 25} {}])) 260 | 261 | #_(is (= (diff mary (human {:name "Mary" :age 18 :pets [(cat {:name "Ringo"}) (dog {:name "George"})]})) 262 | [{} {} {:age 18, 263 | :name "Mary", 264 | :pets #{(cat {:name "Ringo"}) (dog {:name "George"})}}])))) 265 | 266 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 267 | ;; docstrings 268 | (defspec Complicated 269 | "A complicated thing that really needs documentation" 270 | [name :is-a :string]) 271 | 272 | (defunion Complexity 273 | "Complexity is complicated" 274 | :Complicated) 275 | 276 | (defenum Complications 277 | "Simple isn't easy" 278 | Simple 279 | Easy) 280 | 281 | (deftest test-docstrings 282 | (is (= "A complicated thing that really needs documentation" 283 | (:doc (meta #'Complicated)))) 284 | (is (= "Complexity is complicated" 285 | (:doc (meta #'Complexity)))) 286 | (is (= "Simple isn't easy" 287 | (:doc (meta #'Complications))))) 288 | 289 | 290 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 291 | ;; ns 292 | 293 | (def ns-specs (namespace->specs *ns*)) 294 | (deftest test-namespace->specs 295 | (let [[a b both] (clojure.data/diff 296 | (into #{} (map :name ns-specs)) 297 | #{:TestSpec1 :TestSpec2 :TestSpec3 :TestSpec4 :TestSpec5 298 | :testunion :ES :ESParent :UnionFoo :UnionForward :A :B 299 | :Link :Human :TestSpec6 :TestSpec7 :IsEnum :HasEnum 300 | :TestSpec8 :Complicated :Complexity :Complications})] 301 | (is (= (count both) 22) "total number of specs") 302 | (is (nil? b) "no missing specs") 303 | (is (nil? a) "no extra specs"))) 304 | --------------------------------------------------------------------------------