├── LICENSE ├── README.md ├── cl-rethinkdb-test.asd ├── cl-rethinkdb.asd ├── config.lisp ├── connection.lisp ├── package.lisp ├── protocol.lisp ├── query.lisp ├── reql ├── commands.lisp ├── dsl.lisp ├── function.lisp ├── pseudotypes.lisp └── types.lisp ├── scripts ├── generate.sh └── ql2.proto ├── test ├── driver.lisp ├── run.lisp └── util.lisp └── util.lisp /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013 Lyon Bros. Enterprises, LLC 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | cl-rethinkdb - RethinkDB driver for Common Lisp 2 | =============================================== 3 | This is an async [RethinkDB](http://www.rethinkdb.com/) driver for *everyone's* 4 | favorite programming language. It does its best to follow the [query language 5 | specification](http://www.rethinkdb.com/api/#js). If it's missing any functions 6 | or has implemented any of them incorrectly, please open an issue. 7 | 8 | *This driver is up to date with RethinkDB's v2.0.x protocol.* 9 | 10 | As with most of my drivers, cl-rethinkdb requires [cl-async](http://orthecreedence.github.io/cl-async/), 11 | and makes heavy use of [cl-async's promises](http://orthecreedence.github.io/blackbird/). 12 | 13 | This driver is built so that later on, more than one TCP backend can be used. 14 | Right now, the only one implemented is cl-async, but usocket/IOLib could just as 15 | easily be used if *someone* puts in the time. 16 | 17 | Documentation 18 | ============= 19 | The driver makes extensive use of promises, as mentioned, so be sure to know your 20 | way around the [promise syntax macros](http://orthecreedence.github.io/blackbird/#nicer-syntax) 21 | when using it. 22 | 23 | Everything needed to use the driver is exported out of the `cl-rethinkdb` 24 | package, which has the nickname `r`. 25 | 26 | DSL 27 | --- 28 | cl-rethinkdb makes use of a query DSL that maps keyword function calls to normal 29 | function calls. It does this so that predefined common lisp functions can be 30 | used instead of giving them rediculous names to avoid naming clashes. 31 | 32 | The DSL is activated by using either the [r](#r-macro) macro (used to build 33 | query forms) or the [fn](#fn-macro) macro (used to build anonymous functions). 34 | 35 | Note that this section only covers the DSL itself. Check out the [full list of 36 | commands](#commands) to start building the query of your dreams. 37 | 38 | ### r (macro) 39 | This macro translates keyword functions into ReQL function calls: 40 | 41 | ```common-lisp 42 | ;; grab first 10 records from the `users` table 43 | (r (:limit (:table "users") 10)) 44 | ``` 45 | 46 | This translates to 47 | ```common-lisp 48 | (cl-rethinkdb-reql::limit (cl-rethinkdb-reql::table "users") 10) 49 | ``` 50 | 51 | ### fn (macro) 52 | This macro creates an anonymous function for use in a RethinkDB query. 53 | 54 | It works very much like the [r macro](#r-macro), and in fact wraps its inner 55 | forms in `r` so that you can use the query DSL from within a function. 56 | 57 | ```common-lisp 58 | ;; return an anonymous function that adds `3` to the given argument 59 | (fn (x) (:+ x 3)) 60 | ``` 61 | 62 | Functions can be mixed in with `r` queries: 63 | 64 | ```common-lisp 65 | ;; find all users older than 24 66 | (r (:filter (:table "users") 67 | (fn (user) 68 | (:< 24 (:attr user "age"))))) 69 | ``` 70 | 71 | Note how inside the `fn` body, we're still using functions prefixed with `:`. 72 | 73 | Sending queries and getting results 74 | ----------------------------------- 75 | Once you've constructed a query via [r](#r-macro), you need to send it to the 76 | server. When the server responds successfully, you will get either an atom (a 77 | single value: integer, boolean, hash, array, etc). or a [cursor](#cursor-class) 78 | which provides an interface to iterate over a set of atoms. 79 | 80 | ### connect (function) 81 | ```common-lisp 82 | (defun connect (host port &key db use-outdated noreply profile read-timeout auth)) 83 | => promise (tcp-socket) 84 | ``` 85 | Connects a socket to the given host/port and returns a promise that's finished 86 | with the socket. 87 | 88 | Usage: 89 | ```common-lisp 90 | (alet ((sock (connect "127.0.0.1" 28015 :db "test"))) 91 | ;; ... do stuff ... 92 | (disconnect sock)) 93 | ``` 94 | 95 | ### run (function) 96 | ```common-lisp 97 | (defun run (sock query-form)) 98 | => promise (atom/cursor profile-data) 99 | ``` 100 | Run a query against the given socket (connected using [connect](#connect-function)). 101 | Returns a promise finished with either the atom the query returns or a cursor to 102 | the query results. 103 | 104 | If `profile` is `t` when calling [connect](#connect), the second promise value 105 | will be the profile data returned with the query. 106 | 107 | `run` can signal the following errors on the promise it returns: 108 | 109 | - [query-client-error](#query-client-error) 110 | - [query-compile-error](#query-compile-error) 111 | - [query-runtime-error](#query-runtime-error) 112 | 113 | Example 114 | ```common-lisp 115 | (alet* ((sock (connect "127.0.0.1" 28015)) 116 | (query (r (:get (:table "users") 12))) ; get user id 12 117 | (value (run sock query))) 118 | (format t "My user is: ~s~%" value) 119 | (disconnect sock)) 120 | ``` 121 | 122 | ### wait-complete (function) 123 | ```common-lisp 124 | (defun wait-complete (sock)) 125 | => promise (t) 126 | ``` 127 | Waits for all queries sent on this socket with `noreply => t` to finish. This 128 | lets you queue up a number of write operations on a socket. You can then call 129 | `wait-complete` on the socket and it will return the response when *all* the 130 | queued operations finish. 131 | 132 | ### cursor (class) 133 | The cursor class keeps track of queries where a sequence of results is returned 134 | (as opposed to an atom). It is generally opaque, having no public accessors. 135 | 136 | Cursor functions/methods: 137 | 138 | - [cursorp](#cursorp-function) 139 | - [next](#next-function) 140 | - [has-next](#has-next-function) 141 | - [to-sequence](#to-sequence-function) 142 | - [to-array](#to-array-function) 143 | - [each](#each-function) 144 | - [stop](#stop-function) 145 | - [stop/disconnect](#stop-disconnect-function) 146 | 147 | ### cursorp (function) 148 | ```common-lisp 149 | (defun cursorp (cursor)) 150 | => t/nil 151 | ``` 152 | Convenience function to tell if the given object is a cursor. 153 | 154 | ### next (function) 155 | ```common-lisp 156 | (defun next (sock cursor)) 157 | => promise (atom) 158 | ``` 159 | Gets the next result from a cursor. Returns a promise that's finished with the 160 | next result. The result could be stored locally already, but it also may need to 161 | be retrieved from the server. 162 | 163 | `next` can signal two errors on the promise it returns: 164 | 165 | - [cursor-overshot](#cursor-overshot) 166 | - [cursor-no-more-results](#cursor-no-more-results) 167 | 168 | ```common-lisp 169 | (alet* ((sock (connect "127.0.0.1" 28015)) 170 | (query (r (:table "users"))) ; get all users 171 | (cursor (run sock query))) 172 | ;; grab the first result from the cursor. 173 | (alet ((user (next sock cursor))) 174 | (format t "first user is: ~s~%" user) 175 | ;; let's grab another user 176 | (alet ((user (next sock cursor))) 177 | (format t "second user is: ~s~%" user) 178 | ;; let the server/driver know we're done with this result set 179 | (stop/disconnect sock cursor)))) 180 | ``` 181 | 182 | ### has-next (function) 183 | ```common-lisp 184 | (defun has-next (cursor)) 185 | => t/nil 186 | ``` 187 | Determines if a cursor has more results available. 188 | 189 | ### to-sequence (function) 190 | ```common-lisp 191 | (defun to-sequence (sock cursor)) 192 | => promise (sequence) 193 | ``` 194 | Given a socket and a cursor, `to-sequence` grabs ALL the results from the cursor, 195 | going out to the server to get more if it has to, and returns them as a sequence 196 | through the returned promise. The sequence type (vector/list) depends on the 197 | value of [\*sequence-type\*](#sequence-type). 198 | 199 | ### to-array (function) 200 | ```common-lisp 201 | (defun to-array (sock cursor)) 202 | => promise (vector) 203 | ``` 204 | Given a socket and a cursor, `to-array` grabs ALL the results from the cursor, 205 | going out to the server to get more if it has to, and returns them as an array 206 | through the returned promise. 207 | 208 | ```common-lisp 209 | (alet* ((sock (connect "127.0.0.1" 28015)) 210 | (query (r (:table "users"))) ; get all users 211 | (cursor (run sock query)) 212 | (all-records (to-array sock cursor))) 213 | (format t "All users: ~s~%" all-records) 214 | ;; cleanup 215 | (stop/disconnect sock cursor)) 216 | ``` 217 | 218 | Don't call `to-array` on a cursor returned from a changefeed. It will just sit 219 | there endlessly saving results to a list it will never return. 220 | 221 | ### each (function) 222 | ```common-lisp 223 | (defun each (sock cursor function)) 224 | => promise 225 | ``` 226 | Call the given function on each of the results of a cursor. The returned promise 227 | is finished when all results have been iterated over. 228 | 229 | ```common-lisp 230 | (alet* ((sock (connect "127.0.0.1" 28015)) 231 | (cursor (run sock (r (:table "users"))))) 232 | ;; print each user 233 | (wait (each sock cursor 234 | (lambda (x) (format t "user: ~s~%" x))) 235 | ;; cleanup 236 | (wait (stop sock cursor) 237 | (disconnect sock)))) 238 | ``` 239 | 240 | `each` is the function you want to use for listening to changes on a cursor that 241 | is returned from a changefeed. 242 | 243 | ### stop (function) 244 | ```common-lisp 245 | (defun stop (sock cursor)) 246 | => promise 247 | ``` 248 | Stops a currently open query/cursor. This cleans up the cursor locally, and also 249 | lets RethinkDB know that the results for this cursor are no longer needed. 250 | Returns a promise that is finished with *no values* when the operation is 251 | complete. 252 | 253 | ### stop/disconnect (function) 254 | ```common-lisp 255 | (defun stop/disconnect (sock cursor)) 256 | => nil 257 | ``` 258 | Calls [stop](#stop-function) on a cursor, and after the stop operation is done 259 | closes the passed socket. Useful as a final termination to an operation that 260 | uses a cursor. 261 | 262 | Note that this function checks if the object passed is indeed a cursor, and if 263 | not, just disconnects the socket without throwing any errors. 264 | 265 | ### disconnect (function) 266 | ```common-lisp 267 | (defun disconnect (sock)) 268 | => nil 269 | ``` 270 | Disconnect a connection to a RethinkDB server. 271 | 272 | Binary data 273 | ----------- 274 | Binary data is now part of the driver. Using it is simple...you pass in an 275 | unsigned byte array (ie `(simple-erray (unsigned-byte 8) (*))`) and the driver 276 | will handle encoding of the binary data for you. Binary data passed in *must* 277 | be of the unsigned-byte type, or your data will just be encoded as an array (or 278 | whatever type it actually is). 279 | 280 | When an object is returned that has binary data, the driver converts it back to 281 | an unsigned byte array. 282 | 283 | You can also *force* usage of the binary type by using the `(:binary ...)` 284 | type in the DSL. It takes 1 argument: a base64 string of your data. Note, 285 | however, that if you do use `(:binary "ZG93biB3aXRoIHRoZSBvcHByZXNzaXZlIGNhcGl0YWxpc3QgcmVnaW1l")`, 286 | when you pull that document out, the data will be encoded as a raw unsigned-byte 287 | array (not a base64 string). 288 | 289 | Config 290 | ------ 291 | These mainly have to do with how you want data returned. 292 | 293 | ### \*sequence-type\* 294 | When a sequence is returned from RethinkDB, it can be either returned as a list 295 | (if `*sequence-type*` is `:list` or as a vector (if `*sequence-type*` is 296 | `:array`). It's really a matter of preference on how you're going to access the 297 | data. (But you may also want to read 298 | [on-sequence-type](https://gist.github.com/gtod/2f17dde3fc8eafc02058) for a 299 | warning about round tripping rethinkdb documents while using `:list`). 300 | 301 | Default: `:list` 302 | 303 | ### \*object-type\* 304 | If an object (as in, key/value object) is returned from RethinkDB, it can be 305 | encoded as a hash table (if `*object-type*` is `:hash`) or as an association 306 | list (if `*object-type*` is `:alist`). Hash tables are almost always more 307 | performant, but alists can be easier to debug. Your choice. 308 | 309 | Default: `:hash` 310 | 311 | Thread safety 312 | ------------- 313 | `cl-rethinkdb` stores all its global state in one variable: `*state*`, which is 314 | exported in the `cl-rethinkdb` package. The `*state*` variable is an instance of 315 | the `cl-rethinkdb:state` CLOS class. This lets you declare a thread-local 316 | variable when starting a thread so there are no collisions when accessing the 317 | library from multiple threads: 318 | 319 | ```common-lisp 320 | (let ((cl-rethinkdb:*state* (make-instance 'cl-rethinkdb:state))) 321 | (as:with-event-loop () 322 | ;; run queries in this context 323 | )) 324 | ``` 325 | 326 | Using `let` in the above context declares `*state*` as a thread local variable, 327 | as opposed to using `setf`, which will just modify the global, shared context. 328 | Be sure that the `let` form happens at the start of the thread and encompasses 329 | the event loop form. 330 | 331 | Commands 332 | -------- 333 | All of the following are accessible via the [r DSL macro](#r-macro) by prefixing 334 | the name with a `:`. So `(table "users")` becomes `(:table "users")`. 335 | 336 | These are almost 100% compatible with the [ReQL specification](http://www.rethinkdb.com/api), 337 | so if you familiarize yourself with the query language, you will automatically 338 | get a good handle on the following. 339 | 340 | For a better understanding of the return types of the following commands, see 341 | [the REQL type hierarchy in the protobuf specification](https://github.com/rethinkdb/rethinkdb/blob/next/src/rdb_protocol/ql2.proto). 342 | 343 | - `db (db-name) => database` 344 | - `db-drop (db-name) => object` 345 | - `db-list () => object` 346 | - `table-create (db table-name &key datacenter primary-key durability) => object` 347 | - `table-drop (db table-name) => object` 348 | - `table-list (db) => object` 349 | - `sync (table) => object` 350 | - `index-create (table name &key function multi) => object` 351 | - `index-drop (table name) => object` 352 | - `index-list (table) => array` 353 | - `index-status (table &rest names) => array` 354 | - `index-wait (table &rest names) => array` 355 | - `changes (select &key squash include-states) => cursor` 356 | - `args (arg-list) => special` 357 | - `binary (base64-string) => binary` 358 | - `insert (table sequence/object &key conflict durability return-changes) => object` 359 | - `update (select object/function &key non-atomic durability return-changes) => object` 360 | - `replace (select object/function &key non-atomic durability return-changes) => object` 361 | - `delete (select &key durability return-changes) => object` 362 | - `db (db-name) => db` 363 | - `table (db table-name &key read-mode identifier-format) => sequence` 364 | - `get (table item-id) => object` 365 | - `get-all (table key/keys &key index) => array` 366 | (`key/keys` can be either a string type or a list of string types) 367 | - `between (sequence left right &key index) => sequence` 368 | - `minval () => constant` 369 | - `maxval () => constant` 370 | - `filter (sequence object/function &key default) => sequence` 371 | - `inner-join (sequence1 sequence2 function) => sequence` 372 | - `outer-join (sequence1 sequence2 function) => sequence` 373 | - `eq-join (sequence1 field sequence2 &key index) => sequence` 374 | - `zip (sequence) => sequence` 375 | - `map (sequence function) => sequence` 376 | - `with-fields (sequence &rest strings) => sequence` 377 | - `concat-map (sequence function) => sequence` 378 | - `order-by (sequence field &rest fields) => sequence` 379 | - `asc (field) => field` 380 | - `desc (field) => field` 381 | - `skip (sequence number) => sequence` 382 | - `limit (sequence number) => sequence` 383 | - `slice (sequence start end) => sequence` 384 | - `nth (sequence number) => object` 385 | - `offsets-of (sequence object/reql-function) => sequence` 386 | - `is-empty (sequence) => boolean` 387 | - `union (sequence &rest sequences) => sequence` 388 | - `sample (sequence count) => sequence` 389 | - `random (lower &optional upper &key float) => number` 390 | - `group` (sequence fields-or-functions &key index) => grouped\_sequence 391 | - `ungroup (grouped-sequence) => sequence` 392 | - `reduce (sequence function) => object` 393 | - `count (sequence &optional object/reql-function) => number` 394 | - `sum (sequence &optional field-or-function) => number` 395 | - `avg (sequence &optional field-or-function) => number` 396 | - `min (sequence &optional field-or-function) => type-of-object-in-sequence` 397 | - `max (sequence &optional field-or-function) => type-of-object-in-sequence` 398 | - `distinct (sequence) => sequence` 399 | - `contains (sequence object) => boolean` 400 | - `count-reduce () => function` 401 | - `sum-reduce (field) => function` 402 | - `avg-reduce (field) => function` 403 | - `attr (object field) => object` 404 | - `row (&optional field) => object` 405 | - `pluck (sequence/object field &rest fields) => sequence/object` 406 | - `without (sequence/object field &rest fields) => sequence/object` 407 | - `merge (object &rest objects) => object` 408 | - `append (array object) => array` 409 | - `prepend (array object) => array` 410 | - `difference (array1 array2) => array` 411 | - `set-insert (array object) => array` 412 | - `set-intersection (array1 array2) => array` 413 | - `set-union (array1 array2) => array` 414 | - `set-difference (array1 array2) => array` 415 | - `has-fields (object string &rest strings) => bool` 416 | - `insert-at (array index object) => array` 417 | - `splice-at (array1 index array2) => array` 418 | - `delete-at (array index) => array` 419 | - `change-at (array index object) => array` 420 | - `keys (object) => array` 421 | - `object (key val &rest) => object` 422 | - `\+ (number/string &rest numbers/strings) => number/string` 423 | - `\- (number &rest numbers) => number` 424 | - `\* (number &rest numbers) => number` 425 | - `/ (number &rest numbers) => number` 426 | - `% (number mod) => number` 427 | - `&& (boolean &rest booleans) => boolean` 428 | - `|| (boolean &rest booleans) => boolean` 429 | - `== (object &rest objects) => boolean` 430 | - `!= (object &rest objects) => boolean` 431 | - `< (object &rest objects) => boolean` 432 | - `<= (object &rest objects) => boolean` 433 | - `> (object &rest objects) => boolean` 434 | - `>= (object &rest objects) => boolean` 435 | - `~ (boolean) => boolean` 436 | - `match (string string-regex) => object` 437 | - `split (string &optional separator max-splits) => array` 438 | - `upcase (string) => string` 439 | - `downcase (string) => string` 440 | - `now () => time` 441 | - `time (timezone year month day &optional hour minute second) => time` 442 | - `epoch-time (timestamp) => time` 443 | - `iso8601 (date &key timezone) => time` 444 | - `in-timezone (time timezone) => time` 445 | - `timezone (time) => string` 446 | - `during (time start end) => boolean` 447 | - `date (time) => time` 448 | - `time-of-day (time) => number` 449 | - `year (time) => number` 450 | - `month (time) => number` 451 | - `day (time) => number` 452 | - `day-of-week (time) => number` 453 | - `day-of-year (time) => number` 454 | - `hours (time) => number` 455 | - `minutes (time) => number` 456 | - `seconds (time) => number` 457 | - `to-iso8601 (time) => string` 458 | - `to-epoch-time (time) => number` 459 | - `monday () => time` 460 | - `tuesday () => time` 461 | - `wednesday () => time` 462 | - `thursday () => time` 463 | - `friday () => time` 464 | - `saturday () => time` 465 | - `sunday () => time` 466 | - `january () => time` 467 | - `february () => time` 468 | - `march () => time` 469 | - `april () => time` 470 | - `may () => time` 471 | - `june () => time` 472 | - `july () => time` 473 | - `august () => time` 474 | - `september () => time` 475 | - `october () => time` 476 | - `november () => time` 477 | - `december () => time` 478 | - `do (function &rest args) => object` 479 | - `branch (boolean true-expr false-expr) => object` 480 | - `for-each (sequence function) => object` 481 | - `error (message) => error` 482 | - `default (top1 top2) => top` 483 | - `expr (lisp-object) => RethinkDB object` 484 | - `js (javascript-str) => object/function` 485 | - `coerce-to (object type) => object` 486 | - `typeof (object) => type-string` 487 | - `info (object) => object` 488 | - `json (string) => object` 489 | - `to-json-string (object) => string` 490 | - `literal (&optional object) => object` 491 | - `geojson (object)) => geometry` 492 | - `to-geojson (geo)) => object` 493 | - `point (lat long)) => geometry` 494 | - `line (&rest array/geo)) => geometry` 495 | - `polygon (&rest array/geo)) => geometry` 496 | - `distance (geo-from geo-to &key geo-system unit)) => number` 497 | - `intersects (geo1 geo2)) => bool` 498 | - `includes (geo1 geo2)) => bool` 499 | - `circle (geo radius &key num-vertices geo-system unit fill)) => geometry` 500 | - `get-intersecting (table geo &key index)) => stream` 501 | - `fill (geo)) => geometry` 502 | - `get-nearest (table geo &key index max-results max-dist geo-system unit)) => array` 503 | - `polygon-sub (geo1 geo2)) => geometry` 504 | 505 | Errors 506 | ------ 507 | These are the errors you may encounter while using this driver. Most (if not 508 | all) errors will be signalled on a promise instead of thrown directly. Errors 509 | on a promise can be caught via [catcher](http://orthecreedence.github.io/blackbird/#catcher). 510 | 511 | ### query-error 512 | A general query error. 513 | 514 | ### query-client-error 515 | _extends [query-error](#query-error)_ 516 | 517 | Thrown when the driver sucks. If you get this, open an issue. 518 | 519 | ### query-compile-error 520 | _extends [query-error](#query-error)_ 521 | 522 | Thrown when a query cannot compile. If you get this, take a close look at your 523 | query forms. 524 | 525 | ### query-runtime-error 526 | _extends [query-error](#query-error)_ 527 | 528 | Thrown when the database has a runtime error. 529 | 530 | ### cursor-error 531 | A general error with a cursor. 532 | 533 | ### cursor-overshot 534 | _extends [cursor-error](#cursor-error)_ 535 | 536 | Thrown when [next](#next-function) is called on a cursor, but the cursor is 537 | currently grabbing more results. 538 | 539 | ### cursor-no-more-results 540 | _extends [cursor-error](#cursor-error)_ 541 | 542 | Thrown when [next](#next-function) is called on a cursor that has no more 543 | results. You can test this by using [has-next](#has-next-function). 544 | 545 | ### reql-error 546 | A REQL error. This is thrown when there's an error in the returned REQL data 547 | from the database. For instance, if a time value comes back without a timestamp 548 | or binary data type comes back without the payload. Generally, if the database 549 | itself is functioning correctly, you won't see this error. 550 | 551 | License 552 | ------- 553 | MIT. Enjoy. 554 | 555 | -------------------------------------------------------------------------------- /cl-rethinkdb-test.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem cl-rethinkdb-test 2 | :author "Andrew Danger Lyon " 3 | :license "MIT" 4 | :version "0.2" 5 | :description "TESTS FOR cl-rethinkdb." 6 | :depends-on (#:cl-async 7 | #:blackbird 8 | #:fiveam 9 | #:cl-rethinkdb 10 | #:cl-ppcre) 11 | :components 12 | ((:module test 13 | :serial t 14 | :components ((:file "util") 15 | (:file "driver") 16 | (:file "run"))))) 17 | 18 | -------------------------------------------------------------------------------- /cl-rethinkdb.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem cl-rethinkdb 2 | :author "Andrew Danger Lyon " 3 | :license "MIT" 4 | :version "0.6.7" 5 | :description "A RethinkDB driver for Common Lisp" 6 | :depends-on (#:blackbird 7 | #:vom 8 | #:local-time 9 | #:event-glue 10 | #:cl-async 11 | #:fast-io 12 | #:jonathan 13 | #:cl-base64 14 | #:cl-hash-util 15 | #:cl-ppcre) 16 | :components 17 | ((:file "util") 18 | (:file "package" :depends-on ("util")) 19 | (:file "config" :depends-on ("package")) 20 | (:file "protocol" :depends-on ("package")) 21 | (:module reql 22 | :serial t 23 | :components 24 | ((:file "types") 25 | (:file "function") 26 | (:file "commands") 27 | (:file "dsl") 28 | (:file "pseudotypes")) 29 | :depends-on ("config")) 30 | (:file "connection" :depends-on (reql "config")) 31 | (:file "query" :depends-on (reql "protocol" "config" "connection")))) 32 | 33 | -------------------------------------------------------------------------------- /config.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb) 2 | 3 | (defvar *sequence-type* :list 4 | "Defines whether data returned as a sequence should be a :list or :array.") 5 | 6 | (defvar *object-type* :hash 7 | "Defines whether data returned as an object should be an :alist or :hash.") 8 | -------------------------------------------------------------------------------- /connection.lisp: -------------------------------------------------------------------------------- 1 | ;;; NOTE: this file contains the base minimum number of functions that it can to 2 | ;;; support connecting/sending/receiving. The idea is to eventually allow socket 3 | ;;; types other than cl-async (usocket, iolib) if desired. 4 | 5 | (in-package :cl-rethinkdb) 6 | 7 | (define-condition connect-error (simple-error) 8 | ((msg :reader connect-error-msg :initarg :msg :initform "")) 9 | (:report (lambda (c s) (format s "Connection error: ~a" (connect-error-msg c)))) 10 | (:documentation "A general connection error condition.")) 11 | 12 | (defparameter *empty* (make-array 0 :element-type '(unsigned-byte 8)) 13 | "An empty data set for setting callbacks. Perhaps a cl-async API for this is 14 | in order??") 15 | 16 | (defun do-connect (host port &key read-timeout) 17 | "Create a connection to the given host/port, and optionally db." 18 | (with-promise (resolve reject) 19 | (let ((sock (as:tcp-connect host port 20 | nil 21 | :event-cb (lambda (ev) (reject ev)) 22 | :read-timeout read-timeout))) 23 | (as:with-delay (0) 24 | (resolve sock))))) 25 | 26 | (defun set-callbacks (sock &key read-cb write-cb event-cb) 27 | "Wraps setting socket callbacks." 28 | (as:write-socket-data sock *empty* 29 | :read-cb read-cb 30 | :write-cb write-cb 31 | :event-cb event-cb)) 32 | 33 | (defun finalize-connect (sock) 34 | "Make sure a connection to the DB was successful." 35 | (with-promise (resolve reject) 36 | (set-callbacks sock 37 | :read-cb (lambda (sock data) 38 | (let ((msg (babel:octets-to-string data))) 39 | (if (string= (subseq msg 0 7) "SUCCESS") 40 | (resolve sock) 41 | (reject (make-instance 'connect-error 42 | :msg (format nil "bad connect: ~a~%" msg)))))) 43 | :event-cb (lambda (ev) (reject ev))))) 44 | 45 | (defun sock-write (sock bytes) 46 | "Send data on a rethinkdb connection." 47 | (as:write-socket-data sock bytes)) 48 | 49 | (defun finalize-query (sock) 50 | "Make sure a socket that just had query data sent over it is ready to handle 51 | the response." 52 | (let* ((dispatch (make-instance 'ev:dispatch)) 53 | (promise (with-promise (resolve reject) 54 | (ev:bind-once :close (lambda (ev) (reject (ev:data ev))) :on dispatch) 55 | (let ((response-handler (make-response-handler))) 56 | (set-callbacks sock 57 | :read-cb (lambda (sock data) 58 | (declare (ignore sock)) 59 | (let ((full-response-bytes (funcall response-handler data))) 60 | (when full-response-bytes 61 | (resolve (parse-response full-response-bytes))))) 62 | :event-cb (lambda (ev) (reject ev))))))) 63 | (values promise dispatch))) 64 | 65 | (defun do-close (sock) 66 | "Close the given socket." 67 | (unless (as:socket-closed-p sock) 68 | (as:close-socket sock))) 69 | 70 | (defmacro socket-data (socket) 71 | "Allow storing of arbitrary data with a socket." 72 | `(as:socket-data ,socket)) 73 | 74 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-rethinkdb-reql 2 | (:use :cl :cl-rethinkdb-util) 3 | ;; steal some things from CL 4 | (:shadow #:make-array 5 | #:replace 6 | #:delete 7 | #:get 8 | #:map 9 | #:nth 10 | #:union 11 | #:reduce 12 | #:count 13 | #:min 14 | #:max 15 | #:merge 16 | #:append 17 | #:type-of 18 | #:set-difference 19 | #:+ 20 | #:- 21 | #:* 22 | #:/ 23 | #:> 24 | #:>= 25 | #:< 26 | #:<= 27 | #:time 28 | #:do 29 | #:error 30 | #:random 31 | #:fill) 32 | ;; only export our DSL functions 33 | (:export #:r 34 | #:fn 35 | #:convert-pseudotypes-recursive 36 | #:reql-error) 37 | (:nicknames :reql)) 38 | 39 | (defpackage :cl-rethinkdb 40 | (:use :cl :cl-rethinkdb-util :blackbird :cl-rethinkdb-reql) 41 | (:export #:*state* 42 | #:state 43 | 44 | #:*sequence-type* 45 | #:*object-type* 46 | 47 | #:query-error 48 | #:query-error-msg 49 | #:query-client-error 50 | #:query-compile-error 51 | #:query-runtime-error 52 | 53 | #:cursor-error 54 | #:cursor-no-more-results 55 | #:cursor-overshot 56 | #:cursor-stopped 57 | 58 | #:reql-error 59 | 60 | #:cursor 61 | #:cursorp 62 | 63 | #:connect 64 | #:disconnect 65 | 66 | #:run 67 | #:wait-complete 68 | #:next 69 | #:has-next 70 | #:to-array 71 | #:to-sequence 72 | #:each 73 | #:stop 74 | #:stop/disconnect 75 | 76 | ;; export ReQL DSL functions 77 | #:r 78 | #:fn) 79 | (:nicknames :r)) 80 | 81 | -------------------------------------------------------------------------------- /protocol.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb) 2 | 3 | (defconstant +proto-version+ #x5f75e83e) 4 | (defconstant +proto-json+ #x7e6970c7) 5 | 6 | (defconstant +proto-query-start+ 1) 7 | (defconstant +proto-query-continue+ 2) 8 | (defconstant +proto-query-stop+ 3) 9 | (defconstant +proto-query-wait+ 4) 10 | 11 | (defconstant +rdb-response-atom+ 1) 12 | (defconstant +rdb-response-sequence+ 2) 13 | (defconstant +rdb-response-partial+ 3) 14 | (defconstant +rdb-response-feed+ 5) 15 | (defconstant +rdb-response-wait-complete+ 4) 16 | (defconstant +rdb-response-client-error+ 16) 17 | (defconstant +rdb-response-compile-error+ 17) 18 | (defconstant +rdb-response-runtime-error+ 18) 19 | 20 | (defconstant +datum-type-null+ 1) 21 | (defconstant +datum-type-bool+ 2) 22 | (defconstant +datum-type-num+ 3) 23 | (defconstant +datum-type-str+ 4) 24 | (defconstant +datum-type-array+ 5) 25 | (defconstant +datum-type-object+ 6) 26 | (defconstant +datum-type-json+ 7) 27 | 28 | -------------------------------------------------------------------------------- /query.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb) 2 | 3 | (define-condition query-error (simple-error) 4 | ((token :reader query-error-token :initarg :token :initform nil) 5 | (query :reader query-error-query :initarg :query :initform nil) 6 | (backtrace :reader query-error-backtrace :initarg :backtrace :initform nil) 7 | (msg :reader query-error-msg :initarg :msg :initform "")) 8 | (:report (lambda (c s) (format s "Query failed (~a): ~a~%---~%~a" (query-error-token c) (query-error-msg c) (query-error-query c)))) 9 | (:documentation "A general query failure condition.")) 10 | 11 | (define-condition query-client-error (query-error) () 12 | (:report (lambda (c s) (format s "Client error: Query (~a): ~a~%---~%~a" (query-error-token c) (query-error-msg c) (query-error-query c)))) 13 | (:documentation "A client error condition.")) 14 | 15 | (define-condition query-compile-error (query-error) () 16 | (:report (lambda (c s) (format s "Query failed to compile (~a): ~a~%---~%~a" (query-error-token c) (query-error-msg c) (query-error-query c)))) 17 | (:documentation "A query compile error condition.")) 18 | 19 | (define-condition query-runtime-error (query-error) () 20 | (:report (lambda (c s) (format s "Query runtime error (~a): ~a~%---~%~a" (query-error-token c) (query-error-msg c) (query-error-query c)))) 21 | (:documentation "A query runtime error condition.")) 22 | 23 | (define-condition cursor-error (simple-error) 24 | ((token :reader cursor-error-token :initarg :token :initform nil) 25 | (cursor :reader cursor-error-cursor :initarg :cursor :initform nil)) 26 | (:report (lambda (c s) (format s "Cursor error (~a): ~a" (cursor-error-token c) (cursor-error-cursor c)))) 27 | (:documentation "Describes a general query error.")) 28 | 29 | (define-condition cursor-no-more-results (cursor-error) () 30 | (:report (lambda (c s) (format s "No more results on cursor (~a): ~a" (cursor-error-token c) (cursor-error-cursor c)))) 31 | (:documentation "Thrown when a cursor has no more results on it.")) 32 | 33 | (define-condition cursor-overshot (cursor-error) () 34 | (:report (lambda (c s) (format s "Cursor overshot, don't call `next` without waiting for results (~a): ~a" 35 | (cursor-error-token c) 36 | (cursor-error-cursor c)))) 37 | (:documentation "Thrown when a cursor has no more results on it.")) 38 | 39 | (define-condition cursor-stopped (cursor-error) () 40 | (:report (lambda (c s) (format s "Cursor being waited on was stopped: ~a" 41 | (cursor-error-cursor c)))) 42 | (:documentation "Thrown when a cursor that has a pending operation is stopped.")) 43 | 44 | (defclass state () 45 | ((token :accessor state-token :initform 0) 46 | (active-queries :accessor active-queries :initform (make-hash-table :test #'eq))) 47 | (:documentation "Tracks all state for the driver.")) 48 | 49 | (defmethod print-object ((state state) s) 50 | (print-unreadable-object (state s :type t :identity t) 51 | (format s "~_token: ~s " (state-token state)) 52 | (format s "~_queries: ~s" (hash-table-count (active-queries state))))) 53 | 54 | (defclass cursor (ev:dispatch) 55 | ((state :accessor cursor-state :initarg :state :initform :new 56 | :documentation "Describes the current state of the query (new, complete, etc).") 57 | (future :accessor cursor-future :initarg :future :initform nil 58 | :documentation "Holds the future that will be finished with the results from this query.") 59 | (token :accessor cursor-token :initarg :token :initform nil 60 | :documentation "Holds the token for this query.") 61 | (last-change :accessor cursor-last-change :initform 0 62 | :documentation "Tracks the last time the query changed state.") 63 | (results :accessor cursor-results :initform nil 64 | :documentation "Holds the current result set from the query.") 65 | (current-result :accessor cursor-current-result :initform 0 66 | :documentation "Tracks which record the cursor points to.") 67 | (debug :accessor cursor-debug :initarg :debug :initform nil 68 | :documentation "Holds freeform debug info for this cursor.")) 69 | (:documentation 70 | "The query class holds the state of a query, as well as the future that will 71 | be finished when the query returns results.")) 72 | 73 | (defmethod (setf cursor-state) :after (x (cursor cursor)) 74 | "Track whenever the state changes in a query." 75 | (setf (cursor-last-change cursor) (get-internal-real-time)) 76 | (ev:trigger (ev:event :state-change :data x) :on cursor)) 77 | 78 | (defmethod (setf cursor-results) :after (x (cursor cursor)) 79 | "Make sure to reset the curr-result pointer when setting in new results." 80 | (declare (ignore x)) 81 | (setf (cursor-current-result cursor) 0)) 82 | 83 | (defun cursorp (cursor) 84 | "Determine if the given object is a cursor." 85 | (typep cursor 'cursor)) 86 | 87 | (defclass connection-options () 88 | ((kv :accessor conn-kv :initarg :kv :initform nil)) 89 | (:documentation "Holds per-connection options.")) 90 | 91 | (defvar *state* (make-instance 'state) 92 | "Holds all tracking state for the RethinkDB driver.") 93 | 94 | (defun generate-token (&key (state *state*)) 95 | "Generates a new token value for a query." 96 | (prog1 (state-token state) (incf (state-token state)))) 97 | 98 | (defun save-cursor (token cursor &key (state *state*)) 99 | "Associate a cursor with a token. Retrievable through get-cursor." 100 | (setf (gethash token (active-queries state)) cursor)) 101 | 102 | (defun get-cursor (token &key (state *state*)) 103 | "Grab a cursor associated with a token. Returns nil if no cursor exists for that 104 | token" 105 | (gethash token (active-queries state))) 106 | 107 | (defun remove-cursor (cursor &key (state *state*)) 108 | "Remove a cursor/token from state tracking." 109 | (let ((token (cursor-token cursor))) 110 | (remhash token (active-queries state)) 111 | (ev:trigger (ev:event :close :data (list token)) :on cursor))) 112 | 113 | (defun make-response-handler () 114 | "This function returns a closure that can be called multiple times with data 115 | from a RethinkDB response. If a full response is received (over one or more 116 | calls) it returns the *full byte array of the response*, otherwise nil. 117 | 118 | Note that the response chunks MUST be passed in in the order received." 119 | (let ((token nil) 120 | (response-buffer (fast-io:make-output-buffer)) 121 | (response-size nil)) 122 | (lambda (bytes) 123 | (let* ((bufsize (fast-io:buffer-position response-buffer)) 124 | (end (if response-size 125 | (- (+ response-size 4 8) 126 | bufsize) 127 | (length bytes))) 128 | (end (min end (length bytes)))) 129 | (fast-io:fast-write-sequence bytes 130 | response-buffer 131 | 0 132 | end)) 133 | (when (and (not token) 134 | (<= 8 (fast-io:buffer-position response-buffer))) 135 | (setf token (unendian (fast-io:finish-output-buffer response-buffer) 8))) 136 | (when (and (not response-size) 137 | (<= 12 (fast-io:buffer-position response-buffer))) 138 | (setf response-size (unendian (fast-io:finish-output-buffer response-buffer) 4 :offset 8))) 139 | ;; calculate current size minus token/size bytes 140 | (let ((cursize (- (fast-io:buffer-position response-buffer) (+ 4 8)))) 141 | (when (and response-size 142 | (<= response-size cursize)) 143 | (let ((output (fast-io:finish-output-buffer response-buffer))) 144 | output)))))) 145 | 146 | (defun json-to-response (json) 147 | ;; make sure that the keys in any hash-tables are strings 148 | (jonathan:parse (babel:octets-to-string json) :as :hash-table)) 149 | 150 | (defun parse-response (response-bytes) 151 | "Given a full response byte array, parse it, find the attached cursor (by 152 | token), and either resolve/reject the cursor's promise with the return of the 153 | query." 154 | (with-promise (resolve reject) 155 | (let* ((token (unendian response-bytes 8)) 156 | (response-unparsed (subseq response-bytes (+ 8 4))) 157 | (response (json-to-response response-unparsed)) 158 | (cursor (get-cursor token)) 159 | (query-form (cursor-debug cursor)) 160 | (response-type (gethash "t" response)) 161 | (value (coerce (gethash "r" response) 'vector)) 162 | (value-set-p nil) 163 | (backtrace (gethash "b" response)) 164 | (profile (gethash "p" response))) 165 | (vom:info "recv: ~a" (babel:octets-to-string response-unparsed)) 166 | (setf (cursor-state cursor) :finished) 167 | (cond ((eq response-type +rdb-response-atom+) 168 | (setf value (aref value 0) 169 | value-set-p t)) 170 | ((eq response-type +rdb-response-sequence+) 171 | ;; we have a sequence, so return a cursor. results accessible via (next ...) 172 | (setf (cursor-results cursor) value 173 | value cursor 174 | value-set-p t)) 175 | ((eq response-type +rdb-response-partial+) 176 | ;; we have a partial sequence, so return a cursor. results accessible via (next ...) 177 | (setf (cursor-results cursor) value 178 | value cursor 179 | value-set-p t 180 | (cursor-state cursor) :partial)) 181 | ((eq response-type +rdb-response-wait-complete+) 182 | ;; we have a NOREPLY_WAIT response. just finish. 183 | (setf (cursor-results cursor) value 184 | value t 185 | value-set-p t)) 186 | ((or (find response-type (list +rdb-response-client-error+ 187 | +rdb-response-compile-error+ 188 | +rdb-response-runtime-error+))) 189 | ;; some kind of error, signal the future... 190 | (let* ((fail-msg (aref value 0)) 191 | (error-obj (make-instance (cond ((eq response-type +rdb-response-client-error+) 192 | 'query-client-error) 193 | ((eq response-type +rdb-response-compile-error+) 194 | 'query-compile-error) 195 | ((eq response-type +rdb-response-runtime-error+) 196 | 'query-runtime-error)) 197 | :msg fail-msg 198 | :query query-form 199 | :backtrace backtrace))) 200 | (reject error-obj) 201 | ;; because i'm paranoid 202 | (setf value-set-p nil)))) 203 | (when value-set-p 204 | (resolve (if (cursorp value) 205 | value 206 | (convert-pseudotypes-recursive value)) 207 | profile)) 208 | ;; if the query is finished, remove it from state tracking. 209 | (when (eq (cursor-state cursor) :finished) 210 | (remove-cursor cursor))))) 211 | 212 | (defun connect (host port &key db use-outdated noreply profile read-timeout auth) 213 | "Connect to a RethinkDB database, optionally specifying the database." 214 | (alet* ((sock (do-connect host port :read-timeout read-timeout))) 215 | ;; write the version 32-bit integer, little-endian 216 | (sock-write sock (endian +proto-version+ 4)) 217 | (if auth 218 | (let ((auth (if (stringp auth) 219 | (babel:string-to-octets auth) 220 | auth))) 221 | (sock-write sock (endian (length auth) 4)) 222 | (sock-write sock auth)) 223 | (sock-write sock (endian 0 4))) 224 | (sock-write sock (endian +proto-json+ 4)) 225 | ;; setup the socket's options 226 | (let* ((kv nil) 227 | (options (make-instance 'connection-options))) 228 | (when db 229 | (push `("db" . ,(cl-rethinkdb-reql::db db)) kv)) 230 | (when use-outdated 231 | (push `("use_outdated" . ,(not (not use-outdated))) kv)) 232 | (when noreply 233 | (push `("noreply" . ,(not (not noreply))) kv)) 234 | (when profile 235 | (push '("profile" . t) kv)) 236 | (setf (conn-kv options) kv 237 | (socket-data sock) options)) 238 | (finalize-connect sock))) 239 | 240 | (defun disconnect (sock) 241 | "Disconnect a RethinkDB connection." 242 | (do-close sock)) 243 | 244 | (defun serialize-query (query) 245 | "Turn a query into a byte array." 246 | (babel:string-to-octets 247 | (let ((jonathan:*null-value* :null)) 248 | (jonathan:to-json query)))) 249 | 250 | ;;; ---------------------------------------------------------------------------- 251 | ;;; Main querying functions 252 | ;;; ---------------------------------------------------------------------------- 253 | 254 | (defmacro with-query ((sock cursor token query state &key reject-on-stop) resolve reject) 255 | (let ((msock (gensym "sock")) 256 | (mcursor (gensym "cursor")) 257 | (mtoken (gensym "token")) 258 | (mstate (gensym "state")) 259 | (serialized (gensym "serialized")) 260 | (finalize-promise (gensym "finalize-promise")) 261 | (dispatch (gensym "dispatch")) 262 | (bind-name (intern (string (gensym "BIND-NAME")) :keyword))) 263 | `(let* ((,msock ,sock) 264 | (,mcursor ,cursor) 265 | (,mtoken ,token) 266 | (,mstate ,state) 267 | (,serialized (serialize-query ,query))) 268 | (sock-write ,msock (endian ,mtoken 8)) 269 | (sock-write ,msock (endian (length ,serialized) 4)) 270 | (sock-write ,msock ,serialized) 271 | (setf (cursor-state ,mcursor) ,mstate) 272 | (multiple-value-bind (,finalize-promise ,dispatch) 273 | (finalize-query ,msock) 274 | ,(when reject-on-stop 275 | `(ev:bind-once :close (lambda (ev) 276 | (declare (ignore ev)) 277 | (unless (find (cursor-state ,mcursor) 278 | '(:finished :stop)) 279 | (ev:trigger (ev:event :close :data (make-instance 'cursor-stopped :cursor ,mcursor)) 280 | :on ,dispatch))) 281 | :on ,mcursor 282 | :name ,bind-name)) 283 | (vom:info "send: ~a" (babel:octets-to-string ,serialized)) 284 | (catcher 285 | (,resolve 286 | ,(if reject-on-stop 287 | `(tap ,finalize-promise 288 | (lambda (&rest args) 289 | (ev:unbind :close ,bind-name :on ,mcursor) )) 290 | finalize-promise)) 291 | (error (e) (,reject e))))))) 292 | 293 | (defun run (sock query-form) 294 | "This function runs the given query, and returns a future that's finished when 295 | the query response comes in." 296 | (with-promise (resolve reject) 297 | (let* ((token (generate-token)) 298 | (query-options (hu:hash)) 299 | (query (list +proto-query-start+ query-form query-options)) 300 | (cursor (make-instance 'cursor :token token :debug query-form)) 301 | (options (socket-data sock)) 302 | (kv (conn-kv options))) 303 | (dolist (opt kv) 304 | (setf (gethash (car opt) query-options) (cdr opt))) 305 | (save-cursor token cursor) 306 | (with-query (sock cursor token query :sent :reject-on-stop t) 307 | resolve reject)))) 308 | 309 | (defun wait-complete (sock) 310 | "Wait for noreply => t queries to come back LOL." 311 | (with-promise (resolve reject) 312 | (let* ((token (generate-token)) 313 | (query (list +proto-query-wait+)) 314 | (cursor (make-instance 'cursor :token token))) 315 | (save-cursor token cursor) 316 | (with-query (sock cursor token query :wait :reject-on-stop t) 317 | resolve reject)))) 318 | 319 | (defun more (sock token) 320 | "Continue a query." 321 | (with-promise (resolve reject) 322 | (let* ((query (list +proto-query-continue+)) 323 | (cursor (get-cursor token))) 324 | (with-query (sock cursor token query :more :reject-on-stop t) 325 | resolve reject)))) 326 | 327 | (defun stop (sock cursor) 328 | "Cleanup a cursor both locally and in the database. Returns a future that is 329 | finished with *no values* once the stop operation has completed." 330 | (with-promise (resolve reject) 331 | (if (cursorp cursor) 332 | (let* ((query (list +proto-query-stop+)) 333 | (token (cursor-token cursor))) 334 | (if (eq (cursor-state cursor) :partial) 335 | (with-query (sock cursor token query :stop) 336 | resolve reject) 337 | (progn 338 | (remove-cursor cursor) 339 | (resolve)))) 340 | (resolve)))) 341 | 342 | ;;; ---------------------------------------------------------------------------- 343 | ;;; API/util functions 344 | ;;; ---------------------------------------------------------------------------- 345 | 346 | (defun stop/disconnect (sock cursor) 347 | "Call stop on a cursor and disconnect the passed socket." 348 | (with-promise (resolve reject) 349 | (if (cursorp cursor) 350 | (catcher 351 | (wait (stop sock cursor) 352 | (resolve (disconnect sock))) 353 | (error (e) (reject e))) 354 | (resolve (disconnect sock))))) 355 | 356 | (defun next (sock cursor) 357 | "Grab the next result from a cursor. Always returns a future since it may have 358 | to get more results from the server." 359 | (with-promise (resolve reject) 360 | (let ((num-results (length (cursor-results cursor))) 361 | (cur-result (cursor-current-result cursor)) 362 | (token (cursor-token cursor))) 363 | (cond ((< num-results cur-result) 364 | ;; shouldn't be here, quit calling next! 365 | (reject (make-instance 'cursor-overshot 366 | :token token 367 | :cursor cursor))) 368 | ((= cur-result num-results) 369 | ;; we're out of results. if this was a partial, get more results, 370 | ;; if not signal a "no more results" error 371 | (catcher 372 | (if (eq (cursor-state cursor) :partial) 373 | ;; moar plz 374 | (alet* ((new-cursor (more sock token))) 375 | (resolve (next sock new-cursor))) 376 | ;; lol none left!!!! 377 | (reject (make-instance 'cursor-no-more-results 378 | :token token 379 | :cursor cursor))) 380 | (error (e) (reject e)))) 381 | (t 382 | ;; have a local result, send it directly into the promise 383 | (resolve (convert-pseudotypes-recursive (aref (cursor-results cursor) cur-result))))) 384 | ;; keep the pointer up to date 385 | (incf (cursor-current-result cursor))))) 386 | 387 | (defun has-next (cursor) 388 | "Determine if a cursor has more results." 389 | (and (cursorp cursor) 390 | (or (< (cursor-current-result cursor) (length (cursor-results cursor))) 391 | (eq (cursor-state cursor) :partial)))) 392 | 393 | (defun to-array (sock cursor) 394 | "Grab ALL results from a cursor. Returns a future finished with the final 395 | array." 396 | (with-promise (resolve reject) 397 | (cond ((cursorp cursor) 398 | (let ((token (cursor-token cursor))) 399 | (labels ((append-results (all-results) 400 | (catcher 401 | (if (eq (cursor-state cursor) :partial) 402 | (wait (more sock token) 403 | (append-results (concatenate 'vector all-results (cursor-results cursor)))) 404 | (resolve (convert-pseudotypes-recursive all-results))) 405 | (error (e) (reject e))))) 406 | (append-results (cursor-results cursor))))) 407 | ((or (arrayp cursor) 408 | (listp cursor)) 409 | (resolve (convert-pseudotypes-recursive (coerce cursor 'vector)))) 410 | (t (error (format nil "to-array: bad cursor given: ~a" cursor)))))) 411 | 412 | (defun to-sequence (sock cursor) 413 | "Takes a socket and a cursor an returns a sequence of all the items that 414 | cursor points to (the type of sequence returned depends on *sequence-type*)" 415 | (chain (to-array sock cursor) 416 | (:then (arr) 417 | (if (eq *sequence-type* :list) 418 | (coerce arr 'list) 419 | arr)))) 420 | 421 | (defun each (sock cursor function) 422 | "Call the given function on every result in the given cursor." 423 | (with-promise (resolve reject) 424 | (labels ((get-next () 425 | (catcher 426 | (if (has-next cursor) 427 | (alet* ((result (next sock cursor)) 428 | (nil (funcall function result))) 429 | (get-next)) 430 | (resolve)) 431 | (error (e) (reject e))))) 432 | (get-next)))) 433 | 434 | -------------------------------------------------------------------------------- /reql/commands.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb-reql) 2 | 3 | (defparameter *commands* (make-hash-table :test 'eq) 4 | "Holds name -> lambda mappings for our commands.") 5 | 6 | (defun cmd-arg (x) 7 | "Makes sure all DATA (not command) arrays are wrapped in a make-array cmd." 8 | (cond ((alistp x) 9 | (let ((hash (make-hash-table :test #'equal))) 10 | (loop for (k . v) in x do 11 | (setf (gethash k hash) (cmd-arg v))) 12 | hash)) 13 | ((and (listp x) 14 | (not (null x))) 15 | (apply 'make-array x)) 16 | ((typep x '(cl:simple-array (cl:unsigned-byte 8) (cl:*))) 17 | (binary (cl-base64:usb8-array-to-base64-string x))) 18 | ((and (vectorp x) 19 | (not (stringp x))) 20 | (apply 'make-array (coerce x 'list))) 21 | ((hash-table-p x) 22 | (let ((hash (make-hash-table :test #'equal))) 23 | (loop for k being the hash-keys of x 24 | for v being the hash-values of x do 25 | (setf (gethash k hash) (cmd-arg v))) 26 | hash)) 27 | ((null x) 28 | :null) 29 | (t x))) 30 | 31 | (defclass reql-cmd () 32 | ((name :accessor cmd-name :initarg :name :initform "") 33 | (op :accessor cmd-op :initarg :op :initform 0) 34 | (args :accessor cmd-args :initarg :args :initform nil) 35 | (options :accessor cmd-options :initarg :options :initform (hu:hash))) 36 | (:documentation 37 | "Describes a REQL command.")) 38 | 39 | (defmethod make-load-form ((cmd reql-cmd) &optional env) 40 | (declare (ignore env)) 41 | (make-load-form-saving-slots cmd)) 42 | 43 | (defmethod print-object ((cmd reql-cmd) s) 44 | (print-unreadable-object (cmd s :type t :identity t) 45 | (format s "~_~a/~a ~s " 46 | (cmd-name cmd) 47 | (cmd-op cmd) 48 | (cmd-args cmd) 49 | (let ((jonathan:*null-value* :null)) 50 | (jonathan:to-json (cmd-options cmd)))))) 51 | 52 | (defmethod jonathan:%to-json ((cmd reql-cmd)) 53 | (jonathan:with-array 54 | (jonathan:write-item (cmd-op cmd)) 55 | (jonathan:write-item (cmd-args cmd)) 56 | (unless (zerop (hash-table-count (cmd-options cmd))) 57 | (jonathan:write-item (cmd-options cmd))))) 58 | 59 | (defmacro defcommand ((termval name &key (defun t)) all-args &key docstr arrays) 60 | "Wraps creation of commands." 61 | (let* ((restpos (or (position '&rest all-args) (length all-args))) 62 | (keypos (or (position '&key all-args) (length all-args))) 63 | (args (subseq all-args 0 (cl:min restpos keypos))) 64 | (restargs (subseq all-args (cl:min (length all-args) (1+ restpos)))) 65 | (optargs (subseq all-args (cl:min (length all-args) (1+ keypos)))) 66 | (optarg-keys (mapcar (lambda (x) (cl-ppcre:regex-replace-all "-" (string-downcase (string x)) "_")) 67 | optargs)) 68 | (optargs-processed (mapcar (lambda (x) (list x nil (intern (concatenate 'string (string x) "-PASSED-P")))) 69 | optargs)) 70 | (lambda-list (cl:append args 71 | (unless (zerop (length restargs)) (list '&rest (car restargs))) 72 | (unless (zerop (length optargs)) '(&key)) 73 | optargs-processed)) 74 | (process-args (lambda () 75 | (loop for x in args collect 76 | (if (find x arrays) 77 | `(cond ((and (listp ,x) 78 | (not (null ,x))) 79 | ,x) 80 | ((simple-vector-p ,x) 81 | (coerce ,x 'list)) 82 | (t 83 | (list ,x))) 84 | `(list ,x))))) 85 | (hash-sym (gensym "hash")) 86 | (name-keyword (intern (string name) :keyword))) 87 | `(let ((fn (lambda ,lambda-list 88 | (let ((,hash-sym (hu:hash))) 89 | ,@(loop for key in optargs 90 | for jskey in optarg-keys 91 | for default in optargs-processed collect 92 | `(when ,(caddr default) 93 | (setf (gethash ,jskey ,hash-sym) (or ,key :null)))) 94 | (make-instance 'reql-cmd 95 | :name ,name-keyword 96 | :op ,termval 97 | :args (or (mapcar 'cmd-arg 98 | (cl:append ,@(funcall process-args) 99 | ,(car restargs))) 100 | #()) 101 | :options ,hash-sym)))) 102 | (key ,(intern (format nil "~a-~a" (string-upcase (string name)) (length args)) :keyword))) 103 | (setf (gethash key *commands*) fn) 104 | ,(when defun 105 | `(defun ,(if (typep defun 'boolean) 106 | name 107 | defun) 108 | ,lambda-list 109 | ,docstr 110 | (apply fn (cl:append (cl:append (list ,@args) ,(car restargs)) 111 | ,@(loop for default in optargs-processed 112 | for x = (car default) collect 113 | `(if ,(caddr default) 114 | (list ,(intern (string x) :keyword) ,x) 115 | :null))))))))) 116 | 117 | (defun call (fn &rest all-args) 118 | "Call a command by name." 119 | (let* ((keypos (or (position-if (lambda (x) (keywordp x)) all-args) (length all-args))) 120 | (args (subseq all-args 0 keypos)) 121 | (optargs (subseq all-args (cl:min (length all-args) keypos))) 122 | (op-orig fn) 123 | (op-key (intern (string-upcase (format nil "~a-~a" fn (length args))) :keyword)) 124 | (op-key-def1 (intern (string-upcase (format nil "~a-0" fn)) :keyword)) 125 | (op-key-def2 (intern (string-upcase (format nil "~a-1" fn)) :keyword)) 126 | (fn (gethash op-key *commands*)) 127 | (fn (if fn 128 | fn 129 | (gethash op-key-def1 *commands*))) 130 | (fn (if fn 131 | fn 132 | (gethash op-key-def2 *commands*)))) 133 | (if fn 134 | (apply fn (cl:append args 135 | optargs)) 136 | (cl:error (format nil "command ~s (of ~a arguments) not found" op-orig (length args)))))) 137 | 138 | (defcommand (2 make-array) (&rest objects)) 139 | (defcommand (3 make-obj) (hash)) 140 | (defcommand (10 var) (varnumber)) 141 | (defcommand (11 javascript) (string &key timeout)) 142 | (defcommand (169 uuid) ()) 143 | (defcommand (153 http) (url &key data timeout method params header attemps redirects verify page page-limit auth result-format)) 144 | (defcommand (12 error) (errstr)) 145 | (defcommand (13 row) ()) 146 | 147 | (defcommand (14 db) (dbname)) 148 | (defcommand (15 table) (db tablename &key read-mode identifier-format)) 149 | (defcommand (15 table :defun nil) (tablename &key read-mode identifier-format)) 150 | (defcommand (16 get) (table id)) 151 | (defcommand (78 get-all) (table ids &key index) :arrays (ids)) 152 | (defcommand (17 ==) (&rest objects)) 153 | (defcommand (18 !=) (&rest objects)) 154 | (defcommand (19 <) (&rest objects)) 155 | (defcommand (20 <=) (&rest objects)) 156 | (defcommand (21 >) (&rest objects)) 157 | (defcommand (22 >=) (&rest objects)) 158 | (defcommand (23 ~) (bool)) 159 | (defcommand (24 +) (&rest objects)) 160 | (defcommand (25 -) (&rest objects)) 161 | (defcommand (26 *) (&rest objects)) 162 | (defcommand (27 /) (&rest objects)) 163 | (defcommand (28 %) (number mod)) 164 | 165 | (defcommand (29 append) (array object)) 166 | (defcommand (80 prepend) (array object)) 167 | (defcommand (95 difference) (array1 array2)) 168 | (defcommand (88 set-insert) (array object)) 169 | (defcommand (89 set-intersection) (array1 array2)) 170 | (defcommand (90 set-union) (array1 array2)) 171 | (defcommand (91 set-difference) (array1 array2)) 172 | 173 | (defcommand (30 slice) (sequence start end)) 174 | (defcommand (70 skip) (sequence number)) 175 | (defcommand (71 limit) (sequence number)) 176 | (defcommand (87 offsets-of) (sequence object/function)) 177 | (defcommand (93 contains) (sequence object/function)) 178 | 179 | (defcommand (31 attr) (object key)) 180 | (defcommand (94 keys) (object)) 181 | (defcommand (143 object) (&rest pairs)) 182 | (defcommand (32 has-fields) (object &rest pathspec)) 183 | (defcommand (96 with-fields) (sequence &rest pathspec)) 184 | (defcommand (33 pluck) (sequence &rest pathspec)) 185 | (defcommand (34 without) (sequence &rest pathspec)) 186 | (defcommand (35 merge) (&rest objects)) 187 | 188 | (defcommand (36 between-dep) (stream left right &key index right-bound left-bound)) 189 | (defcommand (182 between) (stream left right &key index right-bound left-bound)) 190 | (defcommand (180 minval) ()) 191 | (defcommand (181 maxval) ()) 192 | (defcommand (37 reduce) (sequence function)) 193 | (defcommand (38 map) (sequence function)) 194 | 195 | (defcommand (39 filter) (sequence function &key default)) 196 | (defcommand (40 concat-map) (sequence function)) 197 | (defcommand (41 order-by) (sequence fields &key index) :arrays (fields)) 198 | (defcommand (41 order-by :defun nil) (sequence &rest fields)) 199 | (defcommand (41 order-by :defun nil) (sequence &key index)) 200 | (defcommand (42 distinct) (sequence &key index)) 201 | (defcommand (43 count) (sequence)) 202 | (defcommand (86 is-empty) (sequence)) 203 | (defcommand (44 union) (&rest sequences)) 204 | (defcommand (45 nth) (sequence index)) 205 | (defcommand (170 bracket) (sequence/object number/string)) 206 | 207 | (defcommand (48 inner-join) (sequence1 sequence2 function)) 208 | (defcommand (49 outer-join) (sequence1 sequence2 function)) 209 | (defcommand (50 eq-join) (sequence1 field sequence2 &key index)) 210 | (defcommand (72 zip) (sequence)) 211 | (defcommand (173 range) (lower upper)) 212 | (defcommand (173 range :defun nil) (upper)) 213 | (defcommand (173 range :defun nil) ()) 214 | 215 | (defcommand (82 insert-at) (array index val)) 216 | (defcommand (83 delete-at) (array index)) 217 | (defcommand (83 delete-at :defun nil) (array start end)) 218 | (defcommand (84 change-at) (array index object)) 219 | (defcommand (85 splice-at) (array1 index array2)) 220 | 221 | (defcommand (51 coerce-to) (val string)) 222 | (defcommand (52 type-of) (val)) 223 | 224 | (defcommand (53 update) (selection object/function &key non-atomic durability return-changes)) 225 | (defcommand (54 delete) (selection &key durability return-changes)) 226 | (defcommand (55 replace) (selection function &key non-atomic durability return-changes)) 227 | (defcommand (56 insert) (table object &key conflict durability return-changes)) 228 | 229 | (defcommand (57 db-create) (name)) 230 | (defcommand (58 db-drop) (name)) 231 | (defcommand (59 db-list) ()) 232 | 233 | (defcommand (60 table-create) (db name &key primary-key shards replicas primary-replica-tag)) 234 | (defcommand (60 table-create :defun nil) (name &key primary-key shards replicas primary-replica-tag)) 235 | (defcommand (61 table-drop) (db name)) 236 | (defcommand (61 table-drop :defun nil) (name)) 237 | (defcommand (62 table-list) (db)) 238 | (defcommand (62 table-list :defun nil) ()) 239 | (defcommand (174 config) (db/table)) 240 | (defcommand (175 status) (table)) 241 | (defcommand (177 wait) (db/table)) 242 | (defcommand (176 reconfigure) (db/table &key shards replicas primary-replica-tag dry-run)) 243 | (defcommand (179 rebalance) (db/table)) 244 | 245 | (defcommand (138 sync) (table)) 246 | 247 | (defcommand (75 index-create) (table name function &key multi geo)) 248 | (defcommand (75 index-create :defun nil) (table name &key multi geo)) 249 | (defcommand (76 index-drop) (table name)) 250 | (defcommand (77 index-list) (table)) 251 | (defcommand (139 index-status) (table &rest names)) 252 | (defcommand (140 index-wait) (table &rest names)) 253 | (defcommand (156 index-rename) (table from to &key overwrite)) 254 | 255 | (defcommand (64 do) (function &rest args)) 256 | (defcommand (65 branch) (bool true-expr false-expr)) 257 | (defcommand (66 ||) (&rest bools)) 258 | (defcommand (67 &&) (&rest bools)) 259 | (defcommand (68 for-each) (sequence function)) 260 | 261 | (defcommand (69 func) (args body)) 262 | (defcommand (73 asc) (string)) 263 | (defcommand (74 desc) (string)) 264 | 265 | (defcommand (79 info) (object)) 266 | 267 | (defcommand (97 match) (string regex)) 268 | 269 | (defcommand (141 upcase) (string)) 270 | (defcommand (142 downcase) (string)) 271 | 272 | (defcommand (81 sample) (sequence number)) 273 | 274 | (defcommand (92 default) (object default)) 275 | 276 | (defcommand (98 json) (string)) 277 | (defcommand (172 to-json-string) (object)) 278 | 279 | (defcommand (99 iso8601) (string)) 280 | (defcommand (100 to-iso8601) (time)) 281 | (defcommand (101 epoch-time) (number)) 282 | (defcommand (102 to-epoch-time) (time)) 283 | (defcommand (103 now) ()) 284 | (defcommand (104 in-timezone) (time string)) 285 | (defcommand (105 during) (time start end)) 286 | (defcommand (106 date) (time)) 287 | (defcommand (126 time-of-day) (time)) 288 | (defcommand (127 timezone) (time)) 289 | 290 | (defcommand (128 year) (time)) 291 | (defcommand (129 month) (time)) 292 | (defcommand (130 day) (time)) 293 | (defcommand (131 day-of-week) (time)) 294 | (defcommand (132 day-of-year) (time)) 295 | (defcommand (133 hours) (time)) 296 | (defcommand (134 minutes) (time)) 297 | (defcommand (135 seconds) (time)) 298 | (defcommand (136 time) (year month day hour minute second timezone)) 299 | (defcommand (136 time :defun nil) (year month day timezone)) 300 | (defcommand (107 monday) ()) 301 | (defcommand (108 tuesday) ()) 302 | (defcommand (109 wednesday) ()) 303 | (defcommand (110 thursday) ()) 304 | (defcommand (111 friday) ()) 305 | (defcommand (112 saturday) ()) 306 | (defcommand (113 sunday) ()) 307 | (defcommand (114 january) ()) 308 | (defcommand (115 february) ()) 309 | (defcommand (116 march) ()) 310 | (defcommand (117 april) ()) 311 | (defcommand (117 may) ()) 312 | (defcommand (119 june) ()) 313 | (defcommand (120 july) ()) 314 | (defcommand (121 august) ()) 315 | (defcommand (122 september) ()) 316 | (defcommand (123 october) ()) 317 | (defcommand (124 november) ()) 318 | (defcommand (125 december) ()) 319 | 320 | (defcommand (137 literal) (object)) 321 | (defcommand (137 literal :defun nil) ()) 322 | 323 | (defcommand (144 group) (sequence field/function &key index)) 324 | (defcommand (145 sum) (sequence field/function)) 325 | (defcommand (146 avg) (sequence field/function)) 326 | (defcommand (147 min) (sequence field/function)) 327 | (defcommand (148 max) (sequence field/function)) 328 | 329 | (defcommand (149 split) (string &rest args)) 330 | 331 | (defcommand (150 ungroup) (grouped)) 332 | 333 | (defcommand (151 random) (lower-bound upper-bound &key float)) 334 | (defcommand (151 random :defun nil) (upper-bound &key float)) 335 | (defcommand (151 random :defun nil) (&key float)) 336 | 337 | (defcommand (152 changes) (table &key squash include-states)) 338 | (defcommand (154 args) (array)) 339 | 340 | (defcommand (157 geojson) (object)) 341 | (defcommand (158 to-geojson) (geo)) 342 | (defcommand (159 point) (lat long)) 343 | (defcommand (160 line) (&rest array/geo)) 344 | (defcommand (161 polygon) (&rest array/geo)) 345 | (defcommand (162 distance) (geo-from geo-to &key geo-system unit)) 346 | (defcommand (163 intersects) (geo1 geo2)) 347 | (defcommand (164 includes) (geo1 geo2)) 348 | (defcommand (165 circle) (geo radius &key num-vertices geo-system unit fill)) 349 | (defcommand (166 get-intersecting) (table geo &key index)) 350 | (defcommand (167 fill) (geo)) 351 | (defcommand (168 get-nearest) (table geo &key index max-results max-dist geo-system unit)) 352 | (defcommand (171 polygon-sub) (geo1 geo2)) 353 | 354 | ;; this isn't a command since it doesn't fit into the constant -> function num 355 | ;; paradigm, so we just define it here (and in our dsl) 356 | (defun expr (lisp-obj) (cmd-arg lisp-obj)) 357 | 358 | ;; this is a client-only function that takes base64 and wraps it in a format 359 | ;; the server will understand. 360 | ;(defcommand (155 binary) (string)) 361 | (defun binary (base64-string) 362 | (hu:hash ("$reql_type$" "BINARY") 363 | ("data" base64-string))) 364 | 365 | -------------------------------------------------------------------------------- /reql/dsl.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb-reql) 2 | 3 | (defmacro r (&body query-form) 4 | "Wraps query generation in a macro that takes care of pesky function naming 5 | issues. For instance, the function `count` is reserved in CL, so importing 6 | cl-rethinkdb-reql:count into your app might mess a lot of things up. 7 | Instead, you can wrap your queries in (r ...) and use *keywords* for function 8 | names, and all will be well. For instance: 9 | 10 | (r::insert (r::table \"users\") '((\"name\" . \"larry\"))) 11 | 12 | becomes: 13 | 14 | (r (:insert (:table \"users\") '((\"name\" . \"larry\")))) 15 | 16 | This allows you to separate CL functions from query functions both logically 17 | and visually." 18 | ;; collect all our commands (from defcommand) into a big ol' macrolet form 19 | ;; that converts keywords into the function equivalents 20 | (let ((macrolet-forms 21 | (loop for c being the hash-keys of *commands* 22 | for k = (intern (cl-ppcre:regex-replace "-[0-9]$" (symbol-name c) "") 23 | :keyword) 24 | collect `(,k (&rest args) 25 | `(call ,',k ,@args))))) 26 | 27 | `(progn 28 | (macrolet ((:expr (lisp-obj) 29 | `(expr ,lisp-obj)) 30 | (:binary (base64-string) 31 | `(binary ,base64-string)) 32 | ,@(remove-duplicates macrolet-forms :test (lambda (x y) 33 | (eq (car x) (car y))))) 34 | ,@query-form)))) 35 | 36 | 37 | #| 38 | (defun query-builder (form) 39 | "Takes a query form and turns it into a call tree that builds a query when 40 | evaled." 41 | (cond ((and (listp form) 42 | (keywordp (car form))) 43 | (cl:append (list 'call 44 | (car form)) 45 | (mapcar 'query-builder (cdr form)))) 46 | ((listp form) 47 | (mapcar 'query-builder form)) 48 | (t form))) 49 | 50 | (defmacro r (query-form) 51 | "Wraps query generation in a macro that takes care of pesky function naming 52 | issues. For instance, the function `count` is reserved in CL, so importing 53 | cl-rethinkdb-reql:count into your app might mess a lot of things up. 54 | Instead, you can wrap your queries in (r ...) and use *keywords* for function 55 | names, and all will be well. For instance: 56 | 57 | (r::insert (r::table \"users\") '((\"name\" . \"larry\"))) 58 | 59 | becomes: 60 | 61 | (r (:insert (:table \"users\") '((\"name\" . \"larry\")))) 62 | 63 | This allows you to separate CL functions from query functions both logically 64 | and visually." 65 | (query-builder query-form)) 66 | 67 | |# 68 | 69 | -------------------------------------------------------------------------------- /reql/function.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb-reql) 2 | 3 | (defvar *varnum* 0 4 | "Used to track lambda variables in functions.") 5 | 6 | (defun generate-fn-var () 7 | "Returns 'unique' variable 'names' for 'anonymous' 'functions' ;) ;) if you 8 | know what I mean heh heh ;) ;) ;)." 9 | (incf *varnum*)) 10 | 11 | (defmacro fn (args &body body) 12 | "Makes creating anonymous REQL functions easy. Takes a list of arguments (this 13 | is not a real lambda list, just a flat list of args) and wraps the body in 14 | the REQL-generating form 'r'." 15 | (let ((arg-nums (loop for nil in args collect (generate-fn-var)))) 16 | `(symbol-macrolet (,@(loop for a in args 17 | for n in arg-nums 18 | collect (list a `(var ,n)))) 19 | (func ',(apply 'make-array arg-nums) (r ,@body))))) 20 | 21 | -------------------------------------------------------------------------------- /reql/pseudotypes.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb-reql) 2 | 3 | (define-condition reql-error (simple-error) 4 | ((msg :reader reql-error-msg :initarg :msg :initform "")) 5 | (:report (lambda (c s) (format s "REQL error: ~a" (reql-error-msg c)))) 6 | (:documentation "A general reql error")) 7 | 8 | (defun convert-pseudotypes (obj) 9 | "Handle pseudotypes." 10 | (let ((type (and (hash-table-p obj) 11 | (gethash "$reql_type$" obj)) )) 12 | (unless type 13 | (return-from convert-pseudotypes obj)) 14 | (case (intern (string-upcase type) :keyword) 15 | (:time 16 | (let ((epoch (gethash "epoch_time" obj))) 17 | (unless epoch 18 | (cl:error (make-instance 'reql-error :msg "pseudotype TIME missing `epoch_time` field"))) 19 | (local-time:unix-to-timestamp (floor epoch)))) 20 | (:grouped_data 21 | (mapcar (lambda (x) (hu:hash ("group" (elt x 0)) ("reduction" (elt x 1)))) 22 | (gethash "data" obj))) 23 | (:binary 24 | (let ((data (gethash "data" obj))) 25 | (unless data 26 | (cl:error (make-instance 'reql-error :msg "pseudotype BINARY missing `data` field"))) 27 | (cl-base64:base64-string-to-usb8-array data))) 28 | (t obj)))) 29 | 30 | (defun convert-pseudotypes-recursive (obj) 31 | "Recursively handle RethinkDB's pseudotypes in returned objects." 32 | (cond ((and (vectorp obj) 33 | (not (stringp obj))) 34 | (loop for x across obj 35 | for i from 0 do 36 | (setf (aref obj i) (convert-pseudotypes-recursive x)))) 37 | ((listp obj) 38 | (loop for x in obj 39 | for i from 0 collect (convert-pseudotypes-recursive x))) 40 | ((hash-table-p obj) 41 | (loop for k being the hash-keys of obj 42 | for v being the hash-values of obj do 43 | (setf (gethash k obj) (convert-pseudotypes-recursive v))) 44 | (setf obj (convert-pseudotypes obj)))) 45 | obj) 46 | 47 | -------------------------------------------------------------------------------- /reql/types.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb-reql) 2 | 3 | (defun alistp (alist) 4 | "Determine if the given object is an alist." 5 | (flet ((true-cdr-p (element) 6 | (and (consp element) 7 | (cdr element)))) 8 | (and (not (null alist)) 9 | (listp alist) 10 | (every #'true-cdr-p alist)))) 11 | 12 | (deftype alist () '(satisfies alistp)) 13 | 14 | -------------------------------------------------------------------------------- /scripts/generate.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # makes protobuf generation work 4 | export PATH=$PATH:~/.asdf/systems/protobuf/protoc/lisp/:~/.asdf/systems/protobuf/protoc/bin/ 5 | ABSPATH=`pwd -P` 6 | 7 | # generate the set of lisp classes from the protbuf file. once this is complete, 8 | # lisp classes/file can be used *without* compiling the protobuf again, which is 9 | # great because we can distribute the lisp file without having to worry is a 10 | # user can install/compile the protoc-gen-lisp util. 11 | protoc \ 12 | --proto_path=$ABSPATH \ 13 | --lisp_out=. \ 14 | $ABSPATH/ql2.proto 15 | 16 | # use a custom package name (cl-rethinkdb-proto) ...avoids any potential name 17 | # clashes. 18 | sed -i 's|#:protocol-buffer|#:cl-rethinkdb-proto|' ql2.lisp 19 | sed -i 's|protocol-buffer::|cl-rethinkdb-proto::|' ql2.lisp 20 | # on sense in having inconsistencies 21 | sed -i 's|ql2\.lisp|protocol.lisp|' ql2.lisp 22 | # move it to its proper location 23 | mv ql2.lisp ../protocol.lisp 24 | 25 | -------------------------------------------------------------------------------- /scripts/ql2.proto: -------------------------------------------------------------------------------- 1 | //////////////////////////////////////////////////////////////////////////////// 2 | // THE HIGH-LEVEL VIEW // 3 | //////////////////////////////////////////////////////////////////////////////// 4 | 5 | // Process: When you first open a connection, send the magic number 6 | // for the version of the protobuf you're targeting (in the [Version] 7 | // enum). This should **NOT** be sent as a protobuf; just send the 8 | // little-endian 32-bit integer over the wire raw. This number should 9 | // only be sent once per connection. 10 | 11 | // The magic number shall be followed by an authorization key. The 12 | // first 4 bytes are the length of the key to be sent as a little-endian 13 | // 32-bit integer, followed by the key string. Even if there is no key, 14 | // an empty string should be sent (length 0 and no data). 15 | 16 | // Following the authorization key, the client shall send a magic number 17 | // for the communication protocol they want to use (in the [Protocol] 18 | // enum). This shall be a little-endian 32-bit integer. 19 | 20 | // The server will then respond with a NULL-terminated string response. 21 | // "SUCCESS" indicates that the connection has been accepted. Any other 22 | // response indicates an error, and the response string should describe 23 | // the error. 24 | 25 | // Next, for each query you want to send, construct a [Query] protobuf 26 | // and serialize it to a binary blob. Send the blob's size to the 27 | // server encoded as a little-endian 32-bit integer, followed by the 28 | // blob itself. You will recieve a [Response] protobuf back preceded 29 | // by its own size, once again encoded as a little-endian 32-bit 30 | // integer. You can see an example exchange below in **EXAMPLE**. 31 | 32 | // A query consists of a [Term] to evaluate and a unique-per-connection 33 | // [token]. 34 | 35 | // Tokens are used for two things: 36 | // * Keeping track of which responses correspond to which queries. 37 | // * Batched queries. Some queries return lots of results, so we send back 38 | // batches of <1000, and you need to send a [CONTINUE] query with the same 39 | // token to get more results from the original query. 40 | //////////////////////////////////////////////////////////////////////////////// 41 | 42 | message VersionDummy { // We need to wrap it like this for some 43 | // non-conforming protobuf libraries 44 | // This enum contains the magic numbers for your version. See **THE HIGH-LEVEL 45 | // VIEW** for what to do with it. 46 | enum Version { 47 | V0_1 = 0x3f61ba36; 48 | V0_2 = 0x723081e1; // Authorization key during handshake 49 | V0_3 = 0x5f75e83e; // Authorization key and protocol during handshake 50 | V0_4 = 0x400c2d20; // Queries execute in parallel 51 | } 52 | 53 | // The protocol to use after the handshake, specified in V0_3 54 | enum Protocol { 55 | PROTOBUF = 0x271ffc41; 56 | JSON = 0x7e6970c7; 57 | } 58 | } 59 | 60 | // You send one of: 61 | // * A [START] query with a [Term] to evaluate and a unique-per-connection token. 62 | // * A [CONTINUE] query with the same token as a [START] query that returned 63 | // [SUCCESS_PARTIAL] in its [Response]. 64 | // * A [STOP] query with the same token as a [START] query that you want to stop. 65 | // * A [NOREPLY_WAIT] query with a unique per-connection token. The server answers 66 | // with a [WAIT_COMPLETE] [Response]. 67 | message Query { 68 | enum QueryType { 69 | START = 1; // Start a new query. 70 | CONTINUE = 2; // Continue a query that returned [SUCCESS_PARTIAL] 71 | // (see [Response]). 72 | STOP = 3; // Stop a query partway through executing. 73 | NOREPLY_WAIT = 4; 74 | // Wait for noreply operations to finish. 75 | } 76 | optional QueryType type = 1; 77 | // A [Term] is how we represent the operations we want a query to perform. 78 | optional Term query = 2; // only present when [type] = [START] 79 | optional int64 token = 3; 80 | // This flag is ignored on the server. `noreply` should be added 81 | // to `global_optargs` instead (the key "noreply" should map to 82 | // either true or false). 83 | optional bool OBSOLETE_noreply = 4 [default = false]; 84 | 85 | // If this is set to [true], then [Datum] values will sometimes be 86 | // of [DatumType] [R_JSON] (see below). This can provide enormous 87 | // speedups in languages with poor protobuf libraries. 88 | optional bool accepts_r_json = 5 [default = false]; 89 | 90 | message AssocPair { 91 | optional string key = 1; 92 | optional Term val = 2; 93 | } 94 | repeated AssocPair global_optargs = 6; 95 | } 96 | 97 | // A backtrace frame (see `backtrace` in Response below) 98 | message Frame { 99 | enum FrameType { 100 | POS = 1; // Error occured in a positional argument. 101 | OPT = 2; // Error occured in an optional argument. 102 | } 103 | optional FrameType type = 1; 104 | optional int64 pos = 2; // The index of the positional argument. 105 | optional string opt = 3; // The name of the optional argument. 106 | } 107 | message Backtrace { 108 | repeated Frame frames = 1; 109 | } 110 | 111 | // You get back a response with the same [token] as your query. 112 | message Response { 113 | enum ResponseType { 114 | // These response types indicate success. 115 | SUCCESS_ATOM = 1; // Query returned a single RQL datatype. 116 | SUCCESS_SEQUENCE = 2; // Query returned a sequence of RQL datatypes. 117 | SUCCESS_PARTIAL = 3; // Query returned a partial sequence of RQL 118 | // datatypes. If you send a [CONTINUE] query with 119 | // the same token as this response, you will get 120 | // more of the sequence. Keep sending [CONTINUE] 121 | // queries until you get back [SUCCESS_SEQUENCE]. 122 | WAIT_COMPLETE = 4; // A [NOREPLY_WAIT] query completed. 123 | 124 | // These response types indicate failure. 125 | CLIENT_ERROR = 16; // Means the client is buggy. An example is if the 126 | // client sends a malformed protobuf, or tries to 127 | // send [CONTINUE] for an unknown token. 128 | COMPILE_ERROR = 17; // Means the query failed during parsing or type 129 | // checking. For example, if you pass too many 130 | // arguments to a function. 131 | RUNTIME_ERROR = 18; // Means the query failed at runtime. An example is 132 | // if you add together two values from a table, but 133 | // they turn out at runtime to be booleans rather 134 | // than numbers. 135 | } 136 | optional ResponseType type = 1; 137 | 138 | // ResponseNotes are used to provide information about the query 139 | // response that may be useful for people writing drivers or ORMs. 140 | // Currently all the notes we send indicate that a stream has certain 141 | // special properties. 142 | enum ResponseNote { 143 | // The stream is a changefeed stream (e.g. `r.table('test').changes()`). 144 | SEQUENCE_FEED = 1; 145 | // The stream is a point changefeed stream 146 | // (e.g. `r.table('test').get(0).changes()`). 147 | ATOM_FEED = 2; 148 | // The stream is an order_by_limit changefeed stream 149 | // (e.g. `r.table('test').order_by(index: 'id').limit(5).changes()`). 150 | ORDER_BY_LIMIT_FEED = 3; 151 | // The stream is a union of multiple changefeed types that can't be 152 | // collapsed to a single type 153 | // (e.g. `r.table('test').changes().union(r.table('test').get(0).changes())`). 154 | UNIONED_FEED = 4; 155 | // The stream is a changefeed stream and includes notes on what state 156 | // the changefeed stream is in (e.g. objects of the form `{state: 157 | // 'initializing'}`). 158 | INCLUDES_STATES = 5; 159 | } 160 | repeated ResponseNote notes = 6; 161 | 162 | optional int64 token = 2; // Indicates what [Query] this response corresponds to. 163 | 164 | // [response] contains 1 RQL datum if [type] is [SUCCESS_ATOM], or many RQL 165 | // data if [type] is [SUCCESS_SEQUENCE] or [SUCCESS_PARTIAL]. It contains 1 166 | // error message (of type [R_STR]) in all other cases. 167 | repeated Datum response = 3; 168 | 169 | // If [type] is [CLIENT_ERROR], [TYPE_ERROR], or [RUNTIME_ERROR], then a 170 | // backtrace will be provided. The backtrace says where in the query the 171 | // error occured. Ideally this information will be presented to the user as 172 | // a pretty-printed version of their query with the erroneous section 173 | // underlined. A backtrace is a series of 0 or more [Frame]s, each of which 174 | // specifies either the index of a positional argument or the name of an 175 | // optional argument. (Those words will make more sense if you look at the 176 | // [Term] message below.) 177 | optional Backtrace backtrace = 4; // Contains n [Frame]s when you get back an error. 178 | 179 | // If the [global_optargs] in the [Query] that this [Response] is a 180 | // response to contains a key "profile" which maps to a static value of 181 | // true then [profile] will contain a [Datum] which provides profiling 182 | // information about the execution of the query. This field should be 183 | // returned to the user along with the result that would normally be 184 | // returned (a datum or a cursor). In official drivers this is accomplished 185 | // by putting them inside of an object with "value" mapping to the return 186 | // value and "profile" mapping to the profile object. 187 | optional Datum profile = 5; 188 | } 189 | 190 | // A [Datum] is a chunk of data that can be serialized to disk or returned to 191 | // the user in a Response. Currently we only support JSON types, but we may 192 | // support other types in the future (e.g., a date type or an integer type). 193 | message Datum { 194 | enum DatumType { 195 | R_NULL = 1; 196 | R_BOOL = 2; 197 | R_NUM = 3; // a double 198 | R_STR = 4; 199 | R_ARRAY = 5; 200 | R_OBJECT = 6; 201 | // This [DatumType] will only be used if [accepts_r_json] is 202 | // set to [true] in [Query]. [r_str] will be filled with a 203 | // JSON encoding of the [Datum]. 204 | R_JSON = 7; // uses r_str 205 | } 206 | optional DatumType type = 1; 207 | optional bool r_bool = 2; 208 | optional double r_num = 3; 209 | optional string r_str = 4; 210 | 211 | repeated Datum r_array = 5; 212 | message AssocPair { 213 | optional string key = 1; 214 | optional Datum val = 2; 215 | } 216 | repeated AssocPair r_object = 6; 217 | 218 | extensions 10000 to 20000; 219 | } 220 | 221 | // A [Term] is either a piece of data (see **Datum** above), or an operator and 222 | // its operands. If you have a [Datum], it's stored in the member [datum]. If 223 | // you have an operator, its positional arguments are stored in [args] and its 224 | // optional arguments are stored in [optargs]. 225 | // 226 | // A note about type signatures: 227 | // We use the following notation to denote types: 228 | // arg1_type, arg2_type, argrest_type... -> result_type 229 | // So, for example, if we have a function `avg` that takes any number of 230 | // arguments and averages them, we might write: 231 | // NUMBER... -> NUMBER 232 | // Or if we had a function that took one number modulo another: 233 | // NUMBER, NUMBER -> NUMBER 234 | // Or a function that takes a table and a primary key of any Datum type, then 235 | // retrieves the entry with that primary key: 236 | // Table, DATUM -> OBJECT 237 | // Some arguments must be provided as literal values (and not the results of sub 238 | // terms). These are marked with a `!`. 239 | // Optional arguments are specified within curly braces as argname `:` value 240 | // type (e.x `{use_outdated:BOOL}`) 241 | // Many RQL operations are polymorphic. For these, alterantive type signatures 242 | // are separated by `|`. 243 | // 244 | // The RQL type hierarchy is as follows: 245 | // Top 246 | // DATUM 247 | // NULL 248 | // BOOL 249 | // NUMBER 250 | // STRING 251 | // OBJECT 252 | // SingleSelection 253 | // ARRAY 254 | // Sequence 255 | // ARRAY 256 | // Stream 257 | // StreamSelection 258 | // Table 259 | // Database 260 | // Function 261 | // Ordering - used only by ORDER_BY 262 | // Pathspec -- an object, string, or array that specifies a path 263 | // Error 264 | message Term { 265 | enum TermType { 266 | // A RQL datum, stored in `datum` below. 267 | DATUM = 1; 268 | 269 | MAKE_ARRAY = 2; // DATUM... -> ARRAY 270 | // Evaluate the terms in [optargs] and make an object 271 | MAKE_OBJ = 3; // {...} -> OBJECT 272 | 273 | // * Compound types 274 | 275 | // Takes an integer representing a variable and returns the value stored 276 | // in that variable. It's the responsibility of the client to translate 277 | // from their local representation of a variable to a unique _non-negative_ 278 | // integer for that variable. (We do it this way instead of letting 279 | // clients provide variable names as strings to discourage 280 | // variable-capturing client libraries, and because it's more efficient 281 | // on the wire.) 282 | VAR = 10; // !NUMBER -> DATUM 283 | // Takes some javascript code and executes it. 284 | JAVASCRIPT = 11; // STRING {timeout: !NUMBER} -> DATUM | 285 | // STRING {timeout: !NUMBER} -> Function(*) 286 | UUID = 169; // () -> DATUM 287 | 288 | // Takes an HTTP URL and gets it. If the get succeeds and 289 | // returns valid JSON, it is converted into a DATUM 290 | HTTP = 153; // STRING {data: OBJECT | STRING, 291 | // timeout: !NUMBER, 292 | // method: STRING, 293 | // params: OBJECT, 294 | // header: OBJECT | ARRAY, 295 | // attempts: NUMBER, 296 | // redirects: NUMBER, 297 | // verify: BOOL, 298 | // page: FUNC | STRING, 299 | // page_limit: NUMBER, 300 | // auth: OBJECT, 301 | // result_format: STRING, 302 | // } -> STRING | STREAM 303 | 304 | // Takes a string and throws an error with that message. 305 | // Inside of a `default` block, you can omit the first 306 | // argument to rethrow whatever error you catch (this is most 307 | // useful as an argument to the `default` filter optarg). 308 | ERROR = 12; // STRING -> Error | -> Error 309 | // Takes nothing and returns a reference to the implicit variable. 310 | IMPLICIT_VAR = 13; // -> DATUM 311 | 312 | // * Data Operators 313 | // Returns a reference to a database. 314 | DB = 14; // STRING -> Database 315 | // Returns a reference to a table. 316 | TABLE = 15; // Database, STRING, {use_outdated:BOOL, identifier_format:STRING} -> Table 317 | // STRING, {use_outdated:BOOL, identifier_format:STRING} -> Table 318 | // Gets a single element from a table by its primary or a secondary key. 319 | GET = 16; // Table, STRING -> SingleSelection | Table, NUMBER -> SingleSelection | 320 | // Table, STRING -> NULL | Table, NUMBER -> NULL | 321 | GET_ALL = 78; // Table, DATUM..., {index:!STRING} => ARRAY 322 | 323 | // Simple DATUM Ops 324 | EQ = 17; // DATUM... -> BOOL 325 | NE = 18; // DATUM... -> BOOL 326 | LT = 19; // DATUM... -> BOOL 327 | LE = 20; // DATUM... -> BOOL 328 | GT = 21; // DATUM... -> BOOL 329 | GE = 22; // DATUM... -> BOOL 330 | NOT = 23; // BOOL -> BOOL 331 | // ADD can either add two numbers or concatenate two arrays. 332 | ADD = 24; // NUMBER... -> NUMBER | STRING... -> STRING 333 | SUB = 25; // NUMBER... -> NUMBER 334 | MUL = 26; // NUMBER... -> NUMBER 335 | DIV = 27; // NUMBER... -> NUMBER 336 | MOD = 28; // NUMBER, NUMBER -> NUMBER 337 | 338 | // DATUM Array Ops 339 | // Append a single element to the end of an array (like `snoc`). 340 | APPEND = 29; // ARRAY, DATUM -> ARRAY 341 | // Prepend a single element to the end of an array (like `cons`). 342 | PREPEND = 80; // ARRAY, DATUM -> ARRAY 343 | //Remove the elements of one array from another array. 344 | DIFFERENCE = 95; // ARRAY, ARRAY -> ARRAY 345 | 346 | // DATUM Set Ops 347 | // Set ops work on arrays. They don't use actual sets and thus have 348 | // performance characteristics you would expect from arrays rather than 349 | // from sets. All set operations have the post condition that they 350 | // array they return contains no duplicate values. 351 | SET_INSERT = 88; // ARRAY, DATUM -> ARRAY 352 | SET_INTERSECTION = 89; // ARRAY, ARRAY -> ARRAY 353 | SET_UNION = 90; // ARRAY, ARRAY -> ARRAY 354 | SET_DIFFERENCE = 91; // ARRAY, ARRAY -> ARRAY 355 | 356 | SLICE = 30; // Sequence, NUMBER, NUMBER -> Sequence 357 | SKIP = 70; // Sequence, NUMBER -> Sequence 358 | LIMIT = 71; // Sequence, NUMBER -> Sequence 359 | OFFSETS_OF = 87; // Sequence, DATUM -> Sequence | Sequence, Function(1) -> Sequence 360 | CONTAINS = 93; // Sequence, DATUM -> BOOL | Sequence, Function(1) -> BOOL 361 | 362 | // Stream/Object Ops 363 | // Get a particular field from an object, or map that over a 364 | // sequence. 365 | GET_FIELD = 31; // OBJECT, STRING -> DATUM 366 | // | Sequence, STRING -> Sequence 367 | // Return an array containing the keys of the object. 368 | KEYS = 94; // OBJECT -> ARRAY 369 | // Creates an object 370 | OBJECT = 143; // STRING, DATUM, ... -> OBJECT 371 | // Check whether an object contains all the specified fields, 372 | // or filters a sequence so that all objects inside of it 373 | // contain all the specified fields. 374 | HAS_FIELDS = 32; // OBJECT, Pathspec... -> BOOL 375 | // x.with_fields(...) <=> x.has_fields(...).pluck(...) 376 | WITH_FIELDS = 96; // Sequence, Pathspec... -> Sequence 377 | // Get a subset of an object by selecting some attributes to preserve, 378 | // or map that over a sequence. (Both pick and pluck, polymorphic.) 379 | PLUCK = 33; // Sequence, Pathspec... -> Sequence | OBJECT, Pathspec... -> OBJECT 380 | // Get a subset of an object by selecting some attributes to discard, or 381 | // map that over a sequence. (Both unpick and without, polymorphic.) 382 | WITHOUT = 34; // Sequence, Pathspec... -> Sequence | OBJECT, Pathspec... -> OBJECT 383 | // Merge objects (right-preferential) 384 | MERGE = 35; // OBJECT... -> OBJECT | Sequence -> Sequence 385 | 386 | // Sequence Ops 387 | // Get all elements of a sequence between two values. 388 | // Half-open by default, but the openness of either side can be 389 | // changed by passing 'closed' or 'open for `right_bound` or 390 | // `left_bound`. 391 | BETWEEN_DEPRECATED = 36; // Deprecated version of between, which allows `null` to specify unboundedness 392 | // With the newer version, clients should use `r.minval` and `r.maxval` for unboundedness 393 | BETWEEN = 182; // StreamSelection, DATUM, DATUM, {index:!STRING, right_bound:STRING, left_bound:STRING} -> StreamSelection 394 | REDUCE = 37; // Sequence, Function(2) -> DATUM 395 | MAP = 38; // Sequence, Function(1) -> Sequence 396 | // The arity of the function should be 397 | // Sequence..., Function(sizeof...(Sequence)) -> Sequence 398 | 399 | // Filter a sequence with either a function or a shortcut 400 | // object (see API docs for details). The body of FILTER is 401 | // wrapped in an implicit `.default(false)`, and you can 402 | // change the default value by specifying the `default` 403 | // optarg. If you make the default `r.error`, all errors 404 | // caught by `default` will be rethrown as if the `default` 405 | // did not exist. 406 | FILTER = 39; // Sequence, Function(1), {default:DATUM} -> Sequence | 407 | // Sequence, OBJECT, {default:DATUM} -> Sequence 408 | // Map a function over a sequence and then concatenate the results together. 409 | CONCAT_MAP = 40; // Sequence, Function(1) -> Sequence 410 | // Order a sequence based on one or more attributes. 411 | ORDER_BY = 41; // Sequence, (!STRING | Ordering)... -> Sequence 412 | // Get all distinct elements of a sequence (like `uniq`). 413 | DISTINCT = 42; // Sequence -> Sequence 414 | // Count the number of elements in a sequence, or only the elements that match 415 | // a given filter. 416 | COUNT = 43; // Sequence -> NUMBER | Sequence, DATUM -> NUMBER | Sequence, Function(1) -> NUMBER 417 | IS_EMPTY = 86; // Sequence -> BOOL 418 | // Take the union of multiple sequences (preserves duplicate elements! (use distinct)). 419 | UNION = 44; // Sequence... -> Sequence 420 | // Get the Nth element of a sequence. 421 | NTH = 45; // Sequence, NUMBER -> DATUM 422 | // do NTH or GET_FIELD depending on target object 423 | BRACKET = 170; // Sequence | OBJECT, NUMBER | STRING -> DATUM 424 | // OBSOLETE_GROUPED_MAPREDUCE = 46; 425 | // OBSOLETE_GROUPBY = 47; 426 | 427 | INNER_JOIN = 48; // Sequence, Sequence, Function(2) -> Sequence 428 | OUTER_JOIN = 49; // Sequence, Sequence, Function(2) -> Sequence 429 | // An inner-join that does an equality comparison on two attributes. 430 | EQ_JOIN = 50; // Sequence, !STRING, Sequence, {index:!STRING} -> Sequence 431 | ZIP = 72; // Sequence -> Sequence 432 | RANGE = 173; // -> Sequence [0, +inf) 433 | // NUMBER -> Sequence [0, a) 434 | // NUMBER, NUMBER -> Sequence [a, b) 435 | 436 | // Array Ops 437 | // Insert an element in to an array at a given index. 438 | INSERT_AT = 82; // ARRAY, NUMBER, DATUM -> ARRAY 439 | // Remove an element at a given index from an array. 440 | DELETE_AT = 83; // ARRAY, NUMBER -> ARRAY | 441 | // ARRAY, NUMBER, NUMBER -> ARRAY 442 | // Change the element at a given index of an array. 443 | CHANGE_AT = 84; // ARRAY, NUMBER, DATUM -> ARRAY 444 | // Splice one array in to another array. 445 | SPLICE_AT = 85; // ARRAY, NUMBER, ARRAY -> ARRAY 446 | 447 | // * Type Ops 448 | // Coerces a datum to a named type (e.g. "bool"). 449 | // If you previously used `stream_to_array`, you should use this instead 450 | // with the type "array". 451 | COERCE_TO = 51; // Top, STRING -> Top 452 | // Returns the named type of a datum (e.g. TYPE_OF(true) = "BOOL") 453 | TYPE_OF = 52; // Top -> STRING 454 | 455 | // * Write Ops (the OBJECTs contain data about number of errors etc.) 456 | // Updates all the rows in a selection. Calls its Function with the row 457 | // to be updated, and then merges the result of that call. 458 | UPDATE = 53; // StreamSelection, Function(1), {non_atomic:BOOL, durability:STRING, return_changes:BOOL} -> OBJECT | 459 | // SingleSelection, Function(1), {non_atomic:BOOL, durability:STRING, return_changes:BOOL} -> OBJECT | 460 | // StreamSelection, OBJECT, {non_atomic:BOOL, durability:STRING, return_changes:BOOL} -> OBJECT | 461 | // SingleSelection, OBJECT, {non_atomic:BOOL, durability:STRING, return_changes:BOOL} -> OBJECT 462 | // Deletes all the rows in a selection. 463 | DELETE = 54; // StreamSelection, {durability:STRING, return_changes:BOOL} -> OBJECT | SingleSelection -> OBJECT 464 | // Replaces all the rows in a selection. Calls its Function with the row 465 | // to be replaced, and then discards it and stores the result of that 466 | // call. 467 | REPLACE = 55; // StreamSelection, Function(1), {non_atomic:BOOL, durability:STRING, return_changes:BOOL} -> OBJECT | SingleSelection, Function(1), {non_atomic:BOOL, durability:STRING, return_changes:BOOL} -> OBJECT 468 | // Inserts into a table. If `conflict` is replace, overwrites 469 | // entries with the same primary key. If `conflict` is 470 | // update, does an update on the entry. If `conflict` is 471 | // error, or is omitted, conflicts will trigger an error. 472 | INSERT = 56; // Table, OBJECT, {conflict:STRING, durability:STRING, return_changes:BOOL} -> OBJECT | Table, Sequence, {conflict:STRING, durability:STRING, return_changes:BOOL} -> OBJECT 473 | 474 | // * Administrative OPs 475 | // Creates a database with a particular name. 476 | DB_CREATE = 57; // STRING -> OBJECT 477 | // Drops a database with a particular name. 478 | DB_DROP = 58; // STRING -> OBJECT 479 | // Lists all the databases by name. (Takes no arguments) 480 | DB_LIST = 59; // -> ARRAY 481 | // Creates a table with a particular name in a particular 482 | // database. (You may omit the first argument to use the 483 | // default database.) 484 | TABLE_CREATE = 60; // Database, STRING, {primary_key:STRING, shards:NUMBER, replicas:NUMBER, primary_replica_tag:STRING} -> OBJECT 485 | // Database, STRING, {primary_key:STRING, shards:NUMBER, replicas:OBJECT, primary_replica_tag:STRING} -> OBJECT 486 | // STRING, {primary_key:STRING, shards:NUMBER, replicas:NUMBER, primary_replica_tag:STRING} -> OBJECT 487 | // STRING, {primary_key:STRING, shards:NUMBER, replicas:OBJECT, primary_replica_tag:STRING} -> OBJECT 488 | // Drops a table with a particular name from a particular 489 | // database. (You may omit the first argument to use the 490 | // default database.) 491 | TABLE_DROP = 61; // Database, STRING -> OBJECT 492 | // STRING -> OBJECT 493 | // Lists all the tables in a particular database. (You may 494 | // omit the first argument to use the default database.) 495 | TABLE_LIST = 62; // Database -> ARRAY 496 | // -> ARRAY 497 | // Returns the row in the `rethinkdb.table_config` or `rethinkdb.db_config` table 498 | // that corresponds to the given database or table. 499 | CONFIG = 174; // Database -> SingleSelection 500 | // Table -> SingleSelection 501 | // Returns the row in the `rethinkdb.table_status` table that corresponds to the 502 | // given table. 503 | STATUS = 175; // Table -> SingleSelection 504 | // Called on a table, waits for that table to be ready for read/write operations. 505 | // Called on a database, waits for all of the tables in the database to be ready. 506 | // Returns the corresponding row or rows from the `rethinkdb.table_status` table. 507 | WAIT = 177; // Table -> OBJECT 508 | // Database -> OBJECT 509 | // Generates a new config for the given table, or all tables in the given database 510 | // The `shards` and `replicas` arguments are required 511 | RECONFIGURE = 176; // Database, {shards:NUMBER, replicas:NUMBER[, primary_replica_tag:STRING, dry_run:BOOLEAN]} -> OBJECT 512 | // Database, {shards:NUMBER, replicas:OBJECT[, primary_replica_tag:STRING, dry_run:BOOLEAN]} -> OBJECT 513 | // Table, {shards:NUMBER, replicas:NUMBER[, primary_replica_tag:STRING, dry_run:BOOLEAN]} -> OBJECT 514 | // Table, {shards:NUMBER, replicas:OBJECT[, primary_replica_tag:STRING, dry_run:BOOLEAN]} -> OBJECT 515 | // Balances the table's shards but leaves everything else the same. Can also be 516 | // applied to an entire database at once. 517 | REBALANCE = 179; // Table -> OBJECT 518 | // Database -> OBJECT 519 | 520 | // Ensures that previously issued soft-durability writes are complete and 521 | // written to disk. 522 | SYNC = 138; // Table -> OBJECT 523 | 524 | // * Secondary indexes OPs 525 | // Creates a new secondary index with a particular name and definition. 526 | INDEX_CREATE = 75; // Table, STRING, Function(1), {multi:BOOL} -> OBJECT 527 | // Drops a secondary index with a particular name from the specified table. 528 | INDEX_DROP = 76; // Table, STRING -> OBJECT 529 | // Lists all secondary indexes on a particular table. 530 | INDEX_LIST = 77; // Table -> ARRAY 531 | // Gets information about whether or not a set of indexes are ready to 532 | // be accessed. Returns a list of objects that look like this: 533 | // {index:STRING, ready:BOOL[, blocks_processed:NUMBER, blocks_total:NUMBER]} 534 | INDEX_STATUS = 139; // Table, STRING... -> ARRAY 535 | // Blocks until a set of indexes are ready to be accessed. Returns the 536 | // same values INDEX_STATUS. 537 | INDEX_WAIT = 140; // Table, STRING... -> ARRAY 538 | // Renames the given index to a new name 539 | INDEX_RENAME = 156; // Table, STRING, STRING, {overwrite:BOOL} -> OBJECT 540 | 541 | // * Control Operators 542 | // Calls a function on data 543 | FUNCALL = 64; // Function(*), DATUM... -> DATUM 544 | // Executes its first argument, and returns its second argument if it 545 | // got [true] or its third argument if it got [false] (like an `if` 546 | // statement). 547 | BRANCH = 65; // BOOL, Top, Top -> Top 548 | // Returns true if any of its arguments returns true (short-circuits). 549 | OR = 66; // BOOL... -> BOOL 550 | // Returns true if all of its arguments return true (short-circuits). 551 | AND = 67; // BOOL... -> BOOL 552 | // Calls its Function with each entry in the sequence 553 | // and executes the array of terms that Function returns. 554 | FOR_EACH = 68; // Sequence, Function(1) -> OBJECT 555 | 556 | //////////////////////////////////////////////////////////////////////////////// 557 | ////////// Special Terms 558 | //////////////////////////////////////////////////////////////////////////////// 559 | 560 | // An anonymous function. Takes an array of numbers representing 561 | // variables (see [VAR] above), and a [Term] to execute with those in 562 | // scope. Returns a function that may be passed an array of arguments, 563 | // then executes the Term with those bound to the variable names. The 564 | // user will never construct this directly. We use it internally for 565 | // things like `map` which take a function. The "arity" of a [Function] is 566 | // the number of arguments it takes. 567 | // For example, here's what `_X_.map{|x| x+2}` turns into: 568 | // Term { 569 | // type = MAP; 570 | // args = [_X_, 571 | // Term { 572 | // type = Function; 573 | // args = [Term { 574 | // type = DATUM; 575 | // datum = Datum { 576 | // type = R_ARRAY; 577 | // r_array = [Datum { type = R_NUM; r_num = 1; }]; 578 | // }; 579 | // }, 580 | // Term { 581 | // type = ADD; 582 | // args = [Term { 583 | // type = VAR; 584 | // args = [Term { 585 | // type = DATUM; 586 | // datum = Datum { type = R_NUM; 587 | // r_num = 1}; 588 | // }]; 589 | // }, 590 | // Term { 591 | // type = DATUM; 592 | // datum = Datum { type = R_NUM; r_num = 2; }; 593 | // }]; 594 | // }]; 595 | // }]; 596 | FUNC = 69; // ARRAY, Top -> ARRAY -> Top 597 | 598 | // Indicates to ORDER_BY that this attribute is to be sorted in ascending order. 599 | ASC = 73; // !STRING -> Ordering 600 | // Indicates to ORDER_BY that this attribute is to be sorted in descending order. 601 | DESC = 74; // !STRING -> Ordering 602 | 603 | // Gets info about anything. INFO is most commonly called on tables. 604 | INFO = 79; // Top -> OBJECT 605 | 606 | // `a.match(b)` returns a match object if the string `a` 607 | // matches the regular expression `b`. 608 | MATCH = 97; // STRING, STRING -> DATUM 609 | 610 | // Change the case of a string. 611 | UPCASE = 141; // STRING -> STRING 612 | DOWNCASE = 142; // STRING -> STRING 613 | 614 | // Select a number of elements from sequence with uniform distribution. 615 | SAMPLE = 81; // Sequence, NUMBER -> Sequence 616 | 617 | // Evaluates its first argument. If that argument returns 618 | // NULL or throws an error related to the absence of an 619 | // expected value (for instance, accessing a non-existent 620 | // field or adding NULL to an integer), DEFAULT will either 621 | // return its second argument or execute it if it's a 622 | // function. If the second argument is a function, it will be 623 | // passed either the text of the error or NULL as its 624 | // argument. 625 | DEFAULT = 92; // Top, Top -> Top 626 | 627 | // Parses its first argument as a json string and returns it as a 628 | // datum. 629 | JSON = 98; // STRING -> DATUM 630 | // Returns the datum as a JSON string. 631 | // N.B.: we would really prefer this be named TO_JSON and that exists as 632 | // an alias in Python and JavaScript drivers; however it conflicts with the 633 | // standard `to_json` method defined by Ruby's standard json library. 634 | TO_JSON_STRING = 172; // DATUM -> STRING 635 | 636 | // Parses its first arguments as an ISO 8601 time and returns it as a 637 | // datum. 638 | ISO8601 = 99; // STRING -> PSEUDOTYPE(TIME) 639 | // Prints a time as an ISO 8601 time. 640 | TO_ISO8601 = 100; // PSEUDOTYPE(TIME) -> STRING 641 | 642 | // Returns a time given seconds since epoch in UTC. 643 | EPOCH_TIME = 101; // NUMBER -> PSEUDOTYPE(TIME) 644 | // Returns seconds since epoch in UTC given a time. 645 | TO_EPOCH_TIME = 102; // PSEUDOTYPE(TIME) -> NUMBER 646 | 647 | // The time the query was received by the server. 648 | NOW = 103; // -> PSEUDOTYPE(TIME) 649 | // Puts a time into an ISO 8601 timezone. 650 | IN_TIMEZONE = 104; // PSEUDOTYPE(TIME), STRING -> PSEUDOTYPE(TIME) 651 | // a.during(b, c) returns whether a is in the range [b, c) 652 | DURING = 105; // PSEUDOTYPE(TIME), PSEUDOTYPE(TIME), PSEUDOTYPE(TIME) -> BOOL 653 | // Retrieves the date portion of a time. 654 | DATE = 106; // PSEUDOTYPE(TIME) -> PSEUDOTYPE(TIME) 655 | // x.time_of_day == x.date - x 656 | TIME_OF_DAY = 126; // PSEUDOTYPE(TIME) -> NUMBER 657 | // Returns the timezone of a time. 658 | TIMEZONE = 127; // PSEUDOTYPE(TIME) -> STRING 659 | 660 | // These access the various components of a time. 661 | YEAR = 128; // PSEUDOTYPE(TIME) -> NUMBER 662 | MONTH = 129; // PSEUDOTYPE(TIME) -> NUMBER 663 | DAY = 130; // PSEUDOTYPE(TIME) -> NUMBER 664 | DAY_OF_WEEK = 131; // PSEUDOTYPE(TIME) -> NUMBER 665 | DAY_OF_YEAR = 132; // PSEUDOTYPE(TIME) -> NUMBER 666 | HOURS = 133; // PSEUDOTYPE(TIME) -> NUMBER 667 | MINUTES = 134; // PSEUDOTYPE(TIME) -> NUMBER 668 | SECONDS = 135; // PSEUDOTYPE(TIME) -> NUMBER 669 | 670 | // Construct a time from a date and optional timezone or a 671 | // date+time and optional timezone. 672 | TIME = 136; // NUMBER, NUMBER, NUMBER, STRING -> PSEUDOTYPE(TIME) | 673 | // NUMBER, NUMBER, NUMBER, NUMBER, NUMBER, NUMBER, STRING -> PSEUDOTYPE(TIME) | 674 | 675 | // Constants for ISO 8601 days of the week. 676 | MONDAY = 107; // -> 1 677 | TUESDAY = 108; // -> 2 678 | WEDNESDAY = 109; // -> 3 679 | THURSDAY = 110; // -> 4 680 | FRIDAY = 111; // -> 5 681 | SATURDAY = 112; // -> 6 682 | SUNDAY = 113; // -> 7 683 | 684 | // Constants for ISO 8601 months. 685 | JANUARY = 114; // -> 1 686 | FEBRUARY = 115; // -> 2 687 | MARCH = 116; // -> 3 688 | APRIL = 117; // -> 4 689 | MAY = 118; // -> 5 690 | JUNE = 119; // -> 6 691 | JULY = 120; // -> 7 692 | AUGUST = 121; // -> 8 693 | SEPTEMBER = 122; // -> 9 694 | OCTOBER = 123; // -> 10 695 | NOVEMBER = 124; // -> 11 696 | DECEMBER = 125; // -> 12 697 | 698 | // Indicates to MERGE to replace, or remove in case of an empty literal, the 699 | // other object rather than merge it. 700 | LITERAL = 137; // -> Merging 701 | // JSON -> Merging 702 | 703 | // SEQUENCE, STRING -> GROUPED_SEQUENCE | SEQUENCE, FUNCTION -> GROUPED_SEQUENCE 704 | GROUP = 144; 705 | SUM = 145; 706 | AVG = 146; 707 | MIN = 147; 708 | MAX = 148; 709 | 710 | // `str.split()` splits on whitespace 711 | // `str.split(" ")` splits on spaces only 712 | // `str.split(" ", 5)` splits on spaces with at most 5 results 713 | // `str.split(nil, 5)` splits on whitespace with at most 5 results 714 | SPLIT = 149; // STRING -> ARRAY | STRING, STRING -> ARRAY | STRING, STRING, NUMBER -> ARRAY | STRING, NULL, NUMBER -> ARRAY 715 | 716 | UNGROUP = 150; // GROUPED_DATA -> ARRAY 717 | 718 | // Takes a range of numbers and returns a random number within the range 719 | RANDOM = 151; // NUMBER, NUMBER {float:BOOL} -> DATUM 720 | 721 | CHANGES = 152; // TABLE -> STREAM 722 | ARGS = 154; // ARRAY -> SPECIAL (used to splice arguments) 723 | 724 | // BINARY is client-only at the moment, it is not supported on the server 725 | BINARY = 155; // STRING -> PSEUDOTYPE(BINARY) 726 | 727 | GEOJSON = 157; // OBJECT -> PSEUDOTYPE(GEOMETRY) 728 | TO_GEOJSON = 158; // PSEUDOTYPE(GEOMETRY) -> OBJECT 729 | POINT = 159; // NUMBER, NUMBER -> PSEUDOTYPE(GEOMETRY) 730 | LINE = 160; // (ARRAY | PSEUDOTYPE(GEOMETRY))... -> PSEUDOTYPE(GEOMETRY) 731 | POLYGON = 161; // (ARRAY | PSEUDOTYPE(GEOMETRY))... -> PSEUDOTYPE(GEOMETRY) 732 | DISTANCE = 162; // PSEUDOTYPE(GEOMETRY), PSEUDOTYPE(GEOMETRY) {geo_system:STRING, unit:STRING} -> NUMBER 733 | INTERSECTS = 163; // PSEUDOTYPE(GEOMETRY), PSEUDOTYPE(GEOMETRY) -> BOOL 734 | INCLUDES = 164; // PSEUDOTYPE(GEOMETRY), PSEUDOTYPE(GEOMETRY) -> BOOL 735 | CIRCLE = 165; // PSEUDOTYPE(GEOMETRY), NUMBER {num_vertices:NUMBER, geo_system:STRING, unit:STRING, fill:BOOL} -> PSEUDOTYPE(GEOMETRY) 736 | GET_INTERSECTING = 166; // TABLE, PSEUDOTYPE(GEOMETRY) {index:!STRING} -> StreamSelection 737 | FILL = 167; // PSEUDOTYPE(GEOMETRY) -> PSEUDOTYPE(GEOMETRY) 738 | GET_NEAREST = 168; // TABLE, PSEUDOTYPE(GEOMETRY) {index:!STRING, max_results:NUM, max_dist:NUM, geo_system:STRING, unit:STRING} -> ARRAY 739 | POLYGON_SUB = 171; // PSEUDOTYPE(GEOMETRY), PSEUDOTYPE(GEOMETRY) -> PSEUDOTYPE(GEOMETRY) 740 | 741 | // Constants for specifying key ranges 742 | MINVAL = 180; 743 | MAXVAL = 181; 744 | } 745 | optional TermType type = 1; 746 | 747 | // This is only used when type is DATUM. 748 | optional Datum datum = 2; 749 | 750 | repeated Term args = 3; // Holds the positional arguments of the query. 751 | message AssocPair { 752 | optional string key = 1; 753 | optional Term val = 2; 754 | } 755 | repeated AssocPair optargs = 4; // Holds the optional arguments of the query. 756 | // (Note that the order of the optional arguments doesn't matter; think of a 757 | // Hash.) 758 | 759 | extensions 10000 to 20000; 760 | } 761 | 762 | //////////////////////////////////////////////////////////////////////////////// 763 | // EXAMPLE // 764 | //////////////////////////////////////////////////////////////////////////////// 765 | // ```ruby 766 | // r.table('tbl', {:use_outdated => true}).insert([{:id => 0}, {:id => 1}]) 767 | // ``` 768 | // Would turn into: 769 | // Term { 770 | // type = INSERT; 771 | // args = [Term { 772 | // type = TABLE; 773 | // args = [Term { 774 | // type = DATUM; 775 | // datum = Datum { type = R_STR; r_str = "tbl"; }; 776 | // }]; 777 | // optargs = [["use_outdated", 778 | // Term { 779 | // type = DATUM; 780 | // datum = Datum { type = R_BOOL; r_bool = true; }; 781 | // }]]; 782 | // }, 783 | // Term { 784 | // type = MAKE_ARRAY; 785 | // args = [Term { 786 | // type = DATUM; 787 | // datum = Datum { type = R_OBJECT; r_object = [["id", 0]]; }; 788 | // }, 789 | // Term { 790 | // type = DATUM; 791 | // datum = Datum { type = R_OBJECT; r_object = [["id", 1]]; }; 792 | // }]; 793 | // }] 794 | // } 795 | // And the server would reply: 796 | // Response { 797 | // type = SUCCESS_ATOM; 798 | // token = 1; 799 | // response = [Datum { type = R_OBJECT; r_object = [["inserted", 2]]; }]; 800 | // } 801 | // Or, if there were an error: 802 | // Response { 803 | // type = RUNTIME_ERROR; 804 | // token = 1; 805 | // response = [Datum { type = R_STR; r_str = "The table `tbl` doesn't exist!"; }]; 806 | // backtrace = [Frame { type = POS; pos = 0; }, Frame { type = POS; pos = 0; }]; 807 | // } 808 | -------------------------------------------------------------------------------- /test/driver.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-rethinkdb-test 2 | (:use :cl :fiveam :blackbird :cl-rethinkdb :cl-hash-util) 3 | (:shadow cl-rethinkdb:run 4 | blackbird:*debug-on-error*) 5 | (:export #:run-tests)) 6 | (in-package :cl-rethinkdb-test) 7 | (def-suite cl-rethinkdb-test :description "cl-rethinkdb test suite") 8 | (in-suite cl-rethinkdb-test) 9 | 10 | (defmacro setup (bindings error-bind test-body &body check-body) 11 | "Makes setting up standard tests easier." 12 | `(let ,(append bindings (list error-bind)) 13 | (as:with-event-loop () 14 | (catcher 15 | ,test-body 16 | (t (e) (setf ,error-bind e)))) 17 | ,@check-body)) 18 | 19 | (defun conn () 20 | (connect "127.0.0.1" 28015 :db "test" :read-timeout 10)) 21 | 22 | (defun json (obj) 23 | "Guess." 24 | (let ((jonathan:*null-value* :null)) 25 | (jonathan:to-json obj))) 26 | 27 | (test query-lang 28 | "Test that creation/serialization of queries works" 29 | (let ((q1 (json (r:r (:table "test")))) 30 | (q2 (json (r:r (:+ 3 8)))) 31 | (q3 (json (r:fn (x) (:get (:table "users") x))))) 32 | (is (string= q1 "[15,[\"test\"]]")) 33 | (is (string= q2 "[24,[3,8]]")) 34 | (is (cl-ppcre:scan "\\[69,\\[\\[2,\\[[0-9]\+\\]\\],\\[16,\\[\\[15,\\[\"users\"\\]\\],\\[10,\\[[0-9]\+\\]\\]\\]\\]\\]\\]" 35 | q3)))) 36 | 37 | (test (connect :depends-on query-lang) 38 | "Test connections" 39 | (setup ((sock nil)) err 40 | (chain (conn) 41 | (:then (the-sock) 42 | (setf sock the-sock)) 43 | (:catch (e) (setf err e)) 44 | (:finally 45 | (when sock 46 | (disconnect sock)))) 47 | (is (eq err nil)) 48 | (is (typep sock 'as:socket)))) 49 | 50 | (test (reset :depends-on connect) 51 | "Clear out old test stuff." 52 | (setup ((res nil) 53 | sock) err 54 | (chain (conn) 55 | (:then (socket) 56 | (setf sock socket) 57 | (r:run sock (r:r (:table-drop "users")))) 58 | (:then (qres) 59 | (setf res qres)) 60 | (:catch (e) 61 | (setf err e)) 62 | (:finally 63 | (disconnect sock))) 64 | (is (or res err)))) 65 | 66 | (test (setup :depends-on reset) 67 | "Test setting up a table for testing" 68 | (setup ((res nil) 69 | sock) err 70 | (chain (conn) 71 | (:then (socket) 72 | (setf sock socket) 73 | (r:run sock (r:r (:table-create "users")))) 74 | (:then (qres) 75 | (setf res qres)) 76 | (:catch (e) 77 | (setf err e)) 78 | (:finally 79 | (disconnect sock))) 80 | (is (eq (gethash "tables_created" res) 1)) 81 | (is (eq err nil)))) 82 | 83 | (test (insert :depends-on setup) 84 | "Test (multi) inserts" 85 | (setup ((res nil) 86 | (users (list (hash ("name" "andrew") 87 | ("age" 28) 88 | ("pets" '("timmy" "wookie" "lucy"))) 89 | (hash ("name" "larry") 90 | ("age" 52) 91 | ("pets" '("ricky raccoon" "jack (in the pulpit)"))) 92 | (hash ("name" "slappy") 93 | ("age" 23) 94 | ("pets" '("barry"))))) 95 | sock) err 96 | (chain (conn) 97 | (:then (socket) 98 | (setf sock socket) 99 | (let ((query (r:r (:insert (:table "users") users)))) 100 | (r:run sock query))) 101 | (:then (qres) 102 | (setf res qres)) 103 | (:catch (e) (setf err e)) 104 | (:finally (disconnect sock))) 105 | (remhash "generated_keys" res) 106 | (is (string= 107 | (json res) 108 | "{\"unchanged\":0,\"deleted\":0,\"inserted\":3,\"errors\":0,\"skipped\":0,\"replaced\":0}")) 109 | (is (eq err nil)))) 110 | 111 | (test (filter :depends-on insert) 112 | "Test that filtering/functions work properly" 113 | (setup (res sock cur) err 114 | (chain (conn) 115 | (:then (socket) 116 | (setf sock socket) 117 | (r:run sock (r:r (:filter 118 | (:table "users") 119 | (r:fn (x) (:== (:attr x "name") "slappy")))))) 120 | (:then (cursor _) 121 | (declare (ignore _)) 122 | (setf cur cursor) 123 | (next sock cursor)) 124 | (:then (val) 125 | (setf res val)) 126 | (:catch (e) 127 | (setf err e)) 128 | (:finally 129 | (stop/disconnect sock cur))) 130 | (is (eq (gethash "age" res) 23)) 131 | (is (eq err nil)))) 132 | 133 | (test (delete :depends-on filter) 134 | "Test deletes" 135 | (setup (res sock) err 136 | (chain (conn) 137 | (:then (socket) 138 | (setf sock socket) 139 | (r:run sock (r:r (:delete 140 | (:filter 141 | (:table "users") 142 | (r:fn (x) (:== (:attr x "age") 23))))))) 143 | (:then (qres _) 144 | (declare (ignore _)) 145 | (setf res qres)) 146 | (:catch (e) 147 | (setf err e)) 148 | (:finally 149 | (disconnect sock))) 150 | (is (eq (gethash "deleted" res) 1)) 151 | (is (eq err nil)))) 152 | 153 | (test basic-ops 154 | "Test some basic stuff" 155 | (setup (res1 res2 res3 sock) err 156 | (chain (conn) 157 | (:then (socket) 158 | (setf sock socket) 159 | (r:run sock (r:r (:+ 4 5)))) 160 | (:then (res) 161 | (setf res1 res) 162 | (r:run sock (r:r (:do (r:fn (x y) (:* x y)) 163 | 6 9)))) 164 | (:then (res) 165 | (setf res2 res) 166 | (r:run sock (r:r (:match "i am a troll" "i.*troll")))) 167 | (:then (res) 168 | (setf res3 res)) 169 | (:catch (e) 170 | (setf err e)) 171 | (:finally 172 | (disconnect sock))) 173 | (is (eq res1 9)) 174 | (is (eq res2 54)) 175 | (is (eq (gethash "start" res3) 0)) 176 | (is (eq (gethash "end" res3) 12)))) 177 | 178 | -------------------------------------------------------------------------------- /test/run.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-rethinkdb-test) 2 | 3 | (defun run-tests () 4 | (run! 'cl-rethinkdb-test)) 5 | -------------------------------------------------------------------------------- /test/util.lisp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/orthecreedence/cl-rethinkdb/f435e72dce7f900f599ade193859a202fd1ac33e/test/util.lisp -------------------------------------------------------------------------------- /util.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-rethinkdb-util 2 | (:use :cl :blackbird) 3 | (:export #:endian 4 | #:unendian 5 | #:forward-errors 6 | #:do-list/vector 7 | #:do-hash/alist 8 | #:jprint)) 9 | (in-package :cl-rethinkdb-util) 10 | 11 | (defun endian (number num-bytes) 12 | "Convert a number into N bytes little endian." 13 | (let ((vec (make-array num-bytes :element-type '(unsigned-byte 8)))) 14 | (dotimes (i num-bytes) 15 | (let ((val (logand number #xff))) 16 | (setf (aref vec i) val) 17 | (setf number (ash number -8)))) 18 | vec)) 19 | 20 | (defun unendian (bytes num-bytes &key (offset 0)) 21 | "Turns N number of bytes at offset in bytes into an integer." 22 | (let ((num 0)) 23 | (dotimes (i num-bytes) 24 | (setf (ldb (byte 8 (* i 8)) num) (aref bytes (+ i offset)))) 25 | num)) 26 | 27 | (defmacro do-list/vector ((bind-val list/vector) &body body) 28 | "Generifies looping over a list OR vector." 29 | (let ((val (gensym "list/vector"))) 30 | `(let ((,val ,list/vector)) 31 | (if (vectorp ,val) 32 | (loop for ,bind-val across ,val do 33 | ,@body) 34 | (dolist (,bind-val ,val) 35 | ,@body))))) 36 | 37 | (defmacro do-hash/alist (((bind-key bind-val) hash/alist) &body body) 38 | "Generifies looping over a hash table or alist." 39 | (let ((val (gensym "hash/alist")) 40 | (entry (gensym "alist-entry"))) 41 | `(let ((,val ,hash/alist)) 42 | (if (hash-table-p ,val) 43 | (loop for ,bind-key being the hash-keys of ,val 44 | for ,bind-val being the hash-values of ,val do 45 | ,@body) 46 | (dolist (,entry ,val) 47 | (let ((,bind-key (car ,entry)) 48 | (,bind-val (cdr ,entry))) 49 | ,@body)))))) 50 | 51 | (defun jprint (obj &optional (stream t)) 52 | (let ((jonathan:*null-value* :null)) 53 | (jonathan:with-output (stream) 54 | (jonathan:to-json obj))) 55 | (format stream "~%") 56 | nil) 57 | 58 | --------------------------------------------------------------------------------