rethinkdb-2.2.0.3: A driver for RethinkDB 2.2

Safe HaskellNone
LanguageHaskell98

Database.RethinkDB

Contents

Description

Haskell client driver for RethinkDB

Based upon the official Javascript, Python and Ruby API: http://www.rethinkdb.com/api/

How to use

{-# LANGUAGE OverloadedStrings #-}
import qualified Database.RethinkDB as R
import qualified Database.RethinkDB.NoClash

Synopsis

Accessing RethinkDB

connect :: HostName -> Integer -> Maybe String -> IO RethinkDBHandle Source

Create a new connection to the database server

Example: connect using the default port with no passphrase (note: IPv4 and IPv6 supported)

>>> h <- connect "localhost" 28015 Nothing
>>> h <- connect "::1" 28015 Nothing

data RethinkDBHandle Source

A connection to the database server

close :: RethinkDBHandle -> IO () Source

Close an open connection

use :: Database -> RethinkDBHandle -> RethinkDBHandle Source

Set the default database

The new handle is an alias for the old one. Calling close on either one will close both.

serverInfo :: RethinkDBHandle -> IO Datum Source

Get information about the server

run :: (Expr query, Result r) => RethinkDBHandle -> query -> IO r Source

Run a given query and return a Result

>>> run h $ num 1 :: IO Int
1
>>> run h $ str "foo" :: IO (Either RethinkDBError Int)
  • ** Exception: RethinkDB: Unexpected response: "expected Int, encountered String"
>>> run h $ str "foo" :: IO (Maybe Int)
Nothing
>>> run h $ str "foo" :: IO Int
  • ** Exception: RethinkDB: Unexpected response: "expected Int, encountered String"
>>> c <- run h $ table "users" # orderBy [asc "name"] # (!"name"):: IO (Cursor Datum)
>>> next c
Just "bill"
>>> collect c
["nancy","sabrina"]

run' :: Expr query => RethinkDBHandle -> query -> IO Datum Source

Run a given query and return a Datum

runOpts :: (Expr query, Result r) => RethinkDBHandle -> [RunFlag] -> query -> IO r Source

Run a query with the given options

data ReQL Source

A ReQL Term

Instances

Floating ReQL Source 
Fractional ReQL Source 
Num ReQL Source 
Show ReQL Source 
IsString ReQL Source 
Expr ReQL Source 
OptArgs ReQL Source 
((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL, (~) * e ReQL) => Expr (a -> b -> c -> d -> e -> ReQL) Source 
((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL) => Expr (a -> b -> c -> d -> ReQL) Source 
((~) * a ReQL, (~) * b ReQL, (~) * c ReQL) => Expr (a -> b -> c -> ReQL) Source 
((~) * a ReQL, (~) * b ReQL) => Expr (a -> b -> ReQL) Source 
(~) * a ReQL => Expr (a -> ReQL) Source 

class FromDatum a where Source

Minimal complete definition

Nothing

Methods

parseDatum :: Datum -> Parser a Source

Instances

FromDatum Bool Source 
FromDatum Char Source 
FromDatum Double Source 
FromDatum Float Source 
FromDatum Int Source 
FromDatum Int8 Source 
FromDatum Int16 Source 
FromDatum Int32 Source 
FromDatum Int64 Source 
FromDatum Integer Source 
FromDatum Word Source 
FromDatum Word8 Source 
FromDatum Word16 Source 
FromDatum Word32 Source 
FromDatum Word64 Source 
FromDatum String Source 
FromDatum () Source 
FromDatum ByteString Source 
FromDatum ByteString Source 
FromDatum Text Source 
FromDatum UTCTime Source 
FromDatum Value Source 
FromDatum Text Source 
FromDatum ZonedTime Source 
FromDatum LonLat Source 
FromDatum GeoPolygon Source 
FromDatum GeoLine Source 
FromDatum Datum Source 
FromDatum Frame Source 
FromDatum Change Source 
FromDatum WriteResponse Source 
FromDatum a => FromDatum [a] Source 
FromDatum (Ratio Integer) Source 
FromDatum a => FromDatum (Maybe a) Source 
(Ord a, FromDatum a) => FromDatum (Set a) Source 
FromDatum a => FromDatum (Vector a) Source 
(FromDatum a, FromDatum b) => FromDatum (Either a b) Source 
(FromDatum a, FromDatum b) => FromDatum (a, b) Source 
FromDatum a => FromDatum (HashMap [Char] a) Source 
FromDatum a => FromDatum (HashMap Text a) Source 
FromDatum a => FromDatum (Map [Char] a) Source 
FromDatum a => FromDatum (Map Text a) Source 
(FromDatum a, FromDatum b, FromDatum c) => FromDatum (a, b, c) Source 
(FromDatum a, FromDatum b, FromDatum c, FromDatum d) => FromDatum (a, b, c, d) Source 
(FromDatum a, FromDatum b, FromDatum c, FromDatum d, FromDatum e) => FromDatum (a, b, c, d, e) Source 

data RunFlag Source

Per-query settings

Constructors

UseOutdated

Deprecated. Use `ReadMode Outdated` instead

ReadMode ReadMode 
NoReply 
Durability Durability 
Profile 
ArrayLimit Int 

noReplyWait :: RethinkDBHandle -> IO () Source

Wait for NoReply queries to complete on the server

>>> () <- runOpts h [NoReply] $ table "users" # get "bob" # update (\row -> merge row ["occupation" := "teacher"])
>>> noReplyWait h

data Response Source

The response to a query

class Result r where Source

Convert the raw query response into useful values

Minimal complete definition

Nothing

Cursors

next :: Cursor a -> IO (Maybe a) Source

Get the next value from a cursor

collect :: Cursor a -> IO [a] Source

A lazy stream of all the elements in the cursor

collect' :: Cursor a -> IO [a] Source

A strict version of collect

each :: Cursor a -> (a -> IO b) -> IO () Source

Manipulating databases

data Database Source

A database, referenced by name

Constructors

Database 

Fields

databaseName :: Text
 

dbCreate :: Text -> ReQL Source

Create a database on the server

>>> run' h $ dbCreate "dev"
{"config_changes":[{"new_val":{"name":"dev","id":...},"old_val":null}],"dbs_created":1}

dbDrop :: Database -> ReQL Source

Drop a database

>>> run' h $ dbDrop (db "dev")
{"config_changes":[{"new_val":null,"old_val":{"name":"dev","id":...}}],"tables_dropped":0,"dbs_dropped":1}

dbList :: ReQL Source

List the databases on the server

>>> _ <- run' h $ dbList

Manipulating Tables

data Table Source

A table description

Constructors

Table 

Fields

tableDatabase :: Maybe Database

when Nothing, use the connection's database

tableName :: Text
 
tablePrimaryKey :: Maybe Key
 

tableCreate :: Table -> ReQL Source

Create a table on the server

>>> run' h $ tableCreate (table "posts") def
[{"created":1}]
>>> run' h $ tableCreate (table "users"){ tablePrimaryKey = Just "name" } def
[{"created":1}]
>>> run' h $ tableCreate (Table (Just "doctests") "bar" (Just "name")) def
[{"created":1}]
>>> run' h $ ex tableCreate ["datacenter":="orion"] (Table (Just "doctests") "bar" (Just "name")) def
[{"created":1}]

tableDrop :: Table -> ReQL Source

Drop a table

>>> run' h $ tableDrop (table "foo")
{"config_changes":[{"new_val":null,"old_val":{"primary_key":"id","write_acks":"majority","durability":"hard","name":"foo","shards":...,"id":...,"db":"doctests"}}],"tables_dropped":1}

tableList :: Database -> ReQL Source

List the tables in a database

>>> fmap sort $ run h $ tableList (db "doctests") :: IO [String]
["places","posts","users"]

indexCreate :: Expr fun => Text -> fun -> Table -> ReQL Source

Create an index on the table from the given function

>>> run' h $ table "users" # indexCreate "occupation" (!"occupation")
{"created":1}
>>> run' h $ table "users" # ex indexCreate ["multi":=True] "friends" (!"friends")
{"created":1}
>>> run' h $ table "users" # ex indexCreate ["geo":=True] "location" (!"location")
{"created":1}

indexDrop :: Key -> Table -> ReQL Source

Drop an index

>>> run' h $ table "users" # indexDrop "occupation"
{"dropped":1}

indexList :: Table -> ReQL Source

List the indexes on the table

>>> run' h $ indexList (table "users")
["friends","location","occupation"]

indexRename :: Expr table => ReQL -> ReQL -> table -> ReQL Source

indexStatus :: Expr table => [ReQL] -> table -> ReQL Source

Get the status of the given indexes

run' h $ table "users" # indexStatus []

indexWait :: Expr table => [ReQL] -> table -> ReQL Source

Wait for an index to be built

run' h $ table "users" # indexWait []

changes :: Expr seq => seq -> ReQL Source

Return an infinite stream of objects representing changes to a table

>>> cursor <- run h $ table "posts" # changes :: IO (Cursor Datum)
>>> run h $ table "posts" # insert ["author" := "bill", "message" := "bye", "id" := 4] :: IO WriteResponse
{inserted:1}
>>> next cursor
Just {"new_val":{"author":"bill","id":4,"message":"bye"},"old_val":null}

includeStates :: Attribute a Source

Optional argument for changes

includeInitial :: Attribute a Source

Optional argument for changes

Writing data

data Change Source

Constructors

Change 

Fields

oldVal, newVal :: Datum
 

insert :: Expr object => object -> Table -> ReQL Source

Insert a document or a list of documents into a table

>>> run h $ table "users" # insert (map (\x -> ["name":=x]) ["bill", "bob", "nancy" :: Text]) :: IO WriteResponse
{inserted:3}
>>> run h $ table "posts" # insert ["author" := str "bill", "message" := str "hi", "id" := 1] :: IO WriteResponse
{inserted:1}
>>> run h $ table "posts" # insert ["author" := str "bill", "message" := str "hello", "id" := 2, "flag" := str "deleted"] :: IO WriteResponse
{inserted:1}
>>> run h $ table "posts" # insert ["author" := str "bob", "message" := str "lorem ipsum", "id" := 3, "flag" := str "pinned"] :: IO WriteResponse
{inserted:1}

update :: (Expr selection, Expr a) => (ReQL -> a) -> selection -> ReQL Source

Add to or modify the contents of a document

>>> run h $ table "users" # getAll "name" [str "bob"] # update (const ["occupation" := str "tailor"]) :: IO WriteResponse
{replaced:1}

replace :: (Expr selection, Expr a) => (ReQL -> a) -> selection -> ReQL Source

Replace a document with another

>>> run h $ replace (\user -> ["name" := user!"name", "occupation" := str "clothier"]) . R.filter ((R.== str "tailor") . (!?"occupation")) $ table "users" :: IO WriteResponse
{replaced:1}

delete :: Expr selection => selection -> ReQL Source

Delete the documents

>>> run h $ delete . getAll "name" [str "bob"] $ table "users" :: IO WriteResponse
{deleted:1}

sync :: Expr table => table -> ReQL Source

Ensures that writes on a given table are written to permanent storage

>>> run' h $ sync (table "users")
{"synced":1}

returnChanges :: Attribute a Source

Optional argument for returning an array of objects describing the changes made

>>> run h $ table "users" # ex insert [returnChanges] ["name" := "sabrina"] :: IO WriteResponse
{inserted:1,changes:[{"old_val":null,"new_val":{"name":"sabrina"}}]}

nonAtomic :: Attribute a Source

Optional argument for non-atomic writes

>>> run' h $ table "users" # get "sabrina" # update (merge ["lucky_number" := random])
*** Exception: RethinkDB: Runtime error: "Could not prove argument deterministic.  Maybe you want to use the non_atomic flag?"
  in
    {- HERE -}
    update(
      get(table(db("doctests"), "users"), "sabrina"),
      (\b -> merge(b, {lucky_number: random()})))
>>> run h $ table "users" # get "sabrina" # ex update [nonAtomic] (merge ["lucky_number" := random]) :: IO WriteResponse
{replaced:1}

durability :: Durability -> Attribute a Source

Optional argument for soft durability writes

Selecting data

db :: Text -> Database Source

Create a Database reference

>>> run' h $ db "test" # info
{"name":"test","id":...,"type":"DB"}

table :: Text -> Table Source

A table

>>> fmap sort $ run h $ table "users" :: IO [Datum]
[{"post_count":2,"name":"bill"},{"post_count":0,"name":"nancy"}]

get :: Expr s => ReQL -> s -> ReQL Source

Get a document by primary key

>>> run' h $ table "users" # get "nancy"
{"post_count":0,"name":"nancy"}

getAll :: Expr values => Index -> values -> Table -> ReQL Source

Retreive documents by their indexed value

>>> run' h $ table "users" # getAll PrimaryKey [str "bill"]
[{"post_count":2,"name":"bill"}]

filter :: (Expr predicate, Expr seq) => predicate -> seq -> ReQL Source

Filter a sequence given a predicate

>>> run h $ R.filter (R.< 4) [3, 1, 4, 1, 5, 9, 2, 6]
[3,1,1,2]

between :: (Expr left, Expr right, Expr seq) => Index -> Bound left -> Bound right -> seq -> ReQL Source

Query all the documents whose value for the given index is in a given range

>>> run h $ table "users" # between "name" (Closed $ str "a") (Open $ str "c")
[{"post_count":2,"name":"bill"}]

data Bound a Source

An upper or lower bound for between and during

Constructors

Open

An inclusive bound

Fields

getBound :: a
 
Closed

An exclusive bound

Fields

getBound :: a
 
DefaultBound 

Fields

getBound :: a
 
MinVal 
MaxVal 

Instances

Joins

innerJoin :: (Expr a, Expr b, Expr c) => (ReQL -> ReQL -> c) -> a -> b -> ReQL Source

SQL-like inner join of two sequences

>>> sorted $ run' h $ innerJoin (\user post -> user!"name" R.== post!"author") (table "users") (table "posts") # R.zip # orderBy [asc "id"] # pluck ["name", "message"]
[{"name":"bill","message":"hello"},{"name":"bill","message":"hi"}]

outerJoin :: (Expr a, Expr b, Expr c) => (ReQL -> ReQL -> c) -> a -> b -> ReQL Source

SQL-like outer join of two sequences

>>> sorted $ run' h $ outerJoin (\user post -> user!"name" R.== post!"author") (table "users") (table "posts") # R.zip # orderBy [asc "id", asc "name"] # pluck ["name", "message"]
[{"name":"bill","message":"hello"},{"name":"bill","message":"hi"},{"name":"nancy"}]

eqJoin :: (Expr fun, Expr right, Expr left) => fun -> right -> Index -> left -> ReQL Source

An efficient inner_join that uses a key for the left table and an index for the right table.

>>> sorted $ run' h $ table "posts" # eqJoin "author" (table "users") "name" # R.zip # orderBy [asc "id"] # pluck ["name", "message"]
[{"name":"bill","message":"hello"},{"name":"bill","message":"hi"}]

zip :: Expr a => a -> ReQL Source

Merge the "left" and "right" attributes of the objects in a sequence.

>>> fmap sort $ run h $ table "posts" # eqJoin "author" (table "users") "name" # R.zip :: IO [Datum]
[{"post_count":2,"flag":"deleted","name":"bill","author":"bill","id":2,"message":"hello"},{"post_count":2,"name":"bill","author":"bill","id":1,"message":"hi"}]

data Index Source

Constructors

PrimaryKey 
Index Key 

Instances

Transformations

map :: (Expr a, Expr b) => (ReQL -> b) -> a -> ReQL Source

Map a function over a sequence

>>> run h $ R.map (!"a") [["a" := 1], ["a" := 2]]
[1,2]

zipWith :: (Expr left, Expr right, Expr b) => (ReQL -> ReQL -> b) -> left -> right -> ReQL Source

Map over two sequences

>>> run h $ zipWith (+) [1,2] [3,4]
[4,6]

zipWithN :: (Arr a, Expr f) => f -> a -> ReQL Source

Map over multiple sequences

>>> run' h $ zipWithN (\a b c -> expr $ a + b * c) [[1,2],[3,4],[5,6]]
[16,26]

withFields :: Expr seq => [ReQL] -> seq -> ReQL Source

Like hasFields followed by pluck

>>> run' h $ [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # withFields ["a"]
[{"a":1},{"a":2}]

concatMap :: (Expr a, Expr b) => (ReQL -> b) -> a -> ReQL Source

Map a function of a sequence and concat the results

>>> run h $ concatMap id [[1, 2], [3], [4, 5]]
[1,2,3,4,5]

orderBy :: Expr s => [ReQL] -> s -> ReQL Source

Order a sequence by the given keys

>>> run' h $ table "users" # orderBy [desc "post_count", asc "name"] # pluck ["name", "post_count"]
[{"post_count":2,"name":"bill"},{"post_count":0,"name":"nancy"}]
>>> run' h $ table "users" # ex orderBy ["index":="name"] [] # pluck ["name"]
[{"name":"bill"},{"name":"nancy"}]

asc :: ReQL -> ReQL Source

Ascending order

desc :: ReQL -> ReQL Source

Descending order

skip :: (Expr n, Expr seq) => n -> seq -> ReQL Source

Drop elements from the head of a sequence.

>>> run h $ skip 2 [1, 2, 3, 4]
[3,4]

limit :: (Expr n, Expr seq) => n -> seq -> ReQL Source

Limit the size of a sequence.

>>> run h $ limit 2 [1, 2, 3, 4]
[1,2]

slice :: (Expr a, Expr b, Expr c) => a -> b -> c -> ReQL Source

Cut out part of a sequence

>>> run h $ slice 2 4 [1, 2, 3, 4, 5]
[3,4]

indexesOf :: (Expr fun, Expr seq) => fun -> seq -> ReQL Source

The position in the sequence of the elements that match the predicate

>>> run h $ indexesOf (match "ba.") [str "foo", "bar", "baz"]
[1,2]

isEmpty :: Expr seq => seq -> ReQL Source

Test if a sequence is empty

>>> run h $ isEmpty [1]
false

union :: (Expr a, Expr b) => a -> b -> ReQL Source

Join two sequences.

>>> run h $ [1,2,3] `union` ["a", "b", "c" :: Text]
[1,2,3,"a","b","c"]

sample :: (Expr n, Expr seq) => n -> seq -> ReQL Source

Select a given number of elements from a sequence with uniform random distribution

>>> _ <- run' h $ sample 3 [0,1,2,3,4,5,6,7,8,9]

Aggregation

group :: (Expr group, Expr reduction, Expr seq) => (ReQL -> group) -> (ReQL -> reduction) -> seq -> ReQL Source

Turn a grouping function and a reduction function into a grouped map reduce operation

>>> run' h $ table "posts" # orderBy [asc "id"] # group (!"author") (reduce (\a b -> a + "\n" + b) . R.map (!"message"))
[{"group":"bill","reduction":"hi\nhello"},{"group":"bob","reduction":"lorem ipsum"}]
>>> run' h $ table "users" # group ((!0) . splitOn "" . (!"name")) (\users -> let pc = users!"post_count" in [avg pc, R.sum pc])
[{"group":"b","reduction":[2,2]},{"group":"n","reduction":[0,0]}]

reduce :: (Expr a, Expr s) => (ReQL -> ReQL -> a) -> s -> ReQL Source

Reduce a non-empty sequence to a single value

>>> run h $ reduce (+) [1, 2, 3]
6

reduce0 :: (Expr base, Expr seq, Expr a) => (ReQL -> ReQL -> a) -> base -> seq -> ReQL Source

Reduce a sequence to a single value

>>> run h $ reduce0 (+) 0 [1, 2, 3]
6

distinct :: Expr s => s -> ReQL Source

Filter out identical elements of the sequence

>>> fmap sort $ run h $ distinct (table "posts" ! "flag") :: IO [String]
["deleted","pinned"]

contains :: (Expr x, Expr seq) => x -> seq -> ReQL Source

Test if a sequence contains a given element

>>> run' h $ [1,2,3] # contains 1
true

mapReduce :: (Expr reduction, Expr seq) => (ReQL -> reduction) -> seq -> ReQL Source

Rewrite multiple reductions into a single map/reduce operation

Aggregators

count :: Expr a => a -> ReQL Source

The size of a sequence or an array.

>>> run h $ count (table "users")
2

sum :: Expr s => s -> ReQL Source

The sum of a sequence

>>> run h $ sum [1, 2, 3]
6

avg :: Expr s => s -> ReQL Source

The average of a sequence

>>> run h $ avg [1, 2, 3, 4]
2.5

min :: Expr s => s -> ReQL Source

Minimum value

max :: Expr s => s -> ReQL Source

Minimum value

argmin :: (Expr s, Expr a) => (ReQL -> a) -> s -> ReQL Source

Value that minimizes the function

argmax :: (Expr s, Expr a) => (ReQL -> a) -> s -> ReQL Source

Value that maximizes the function

Document manipulation

pluck :: Expr o => [ReQL] -> o -> ReQL Source

Keep only the given attributes

>>> run' h $ [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # pluck ["a"]
[{"a":1},{"a":2},{}]

without :: Expr o => [ReQL] -> o -> ReQL Source

Remove the given attributes from an object

>>> run' h $ [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # without ["a"]
[{"b":2},{"c":7},{"b":4}]

merge :: (Expr a, Expr b) => a -> b -> ReQL Source

Merge two objects together

>>> run' h $ merge ["a" := 1, "b" := 1] ["b" := 1, "c" := 2]
{"a":1,"b":1,"c":2}

append :: (Expr a, Expr b) => a -> b -> ReQL Source

Append a datum to a sequence

>>> run h $ append 3 [1, 2]
[1,2,3]

prepend :: (Expr datum, Expr array) => datum -> array -> ReQL Source

Prepend an element to an array

>>> run h $ prepend 1 [2,3]
[1,2,3]

difference :: (Expr a, Expr b) => a -> b -> ReQL Source

The different of two lists

>>> run h $ [1,2,3,4,5] # difference [2,5]
[1,3,4]

setInsert :: (Expr datum, Expr array) => datum -> array -> ReQL Source

Insert a datum into an array if it is not yet present

>>> run h $ setInsert 3 [1,2,4,4,5]
[1,2,4,5,3]

setUnion :: (Expr a, Expr b) => a -> b -> ReQL Source

The union of two sets

>>> run h $ [1,2] `setUnion` [2,3]
[2,3,1]

setIntersection :: (Expr a, Expr b) => a -> b -> ReQL Source

The intersection of two sets

>>> run h $ [1,2] `setIntersection` [2,3]
[2]

setDifference :: (Expr set, Expr remove) => remove -> set -> ReQL Source

The difference of two sets

>>> run h $ [2,3] # setDifference [1,2]
[3]

(!) :: Expr s => s -> ReQL -> ReQL infixl 9 Source

Get a single field from an object or an element of an array

>>> run h $ ["foo" := True] ! "foo"
true
>>> run h $ [1, 2, 3] ! 0
1

Or a single field from each object in a sequence

>>> run h $ [["foo" := True], ["foo" := False]] ! "foo"
[true,false]

(!?) :: Expr s => s -> ReQL -> ReQL Source

Get a single field, or null if not present

>>> run' h $ empty !? "foo"
null

hasFields :: Expr obj => ReQL -> obj -> ReQL Source

Test if an object has the given fields

>>> run h $ hasFields "a" $ ["a" := 1]
true

insertAt :: (Expr n, Expr datum, Expr array) => n -> datum -> array -> ReQL Source

Insert a datum at the given position in an array

>>> run h $ insertAt 1 4 [1,2,3]
[1,4,2,3]

spliceAt :: (Expr n, Expr replace, Expr array) => n -> replace -> array -> ReQL Source

Splice an array at a given position inside another array

>>> run h $ spliceAt 2 [4,5] [1,2,3]
[1,2,4,5,3]

deleteAt :: (Expr n, Expr array) => n -> array -> ReQL Source

Delete an element from an array

>>> run h $ deleteAt 1 [1,2,3]
[1,3]

changeAt :: (Expr n, Expr datum, Expr array) => n -> datum -> array -> ReQL Source

Change an element in an array

>>> run h $ changeAt 1 4 [1,2,3]
[1,4,3]

keys :: Expr object => object -> ReQL Source

The list of keys of the given object

>>> run h $ keys ["a" := 1, "b" := 2]
["a","b"]

values :: Expr object => object -> ReQL Source

The list of values of the given object

>>> run h $ values ["a" := 1, "b" := 2]
[1,2]

literal :: Expr a => a -> ReQL Source

Literal objects, in a merge or update, are not processed recursively.

>>> run' h $ ["a" := ["b" := 1]] # merge ["a" := literal ["c" := 2]]
{"a":{"c":2}}

remove :: ReQL Source

Remove fields when doing a merge or update

>>> run' h $ ["a" := ["b" := 1]] # merge ["a" := remove]
{}

data Attribute a where Source

A key/value pair used for building objects

Constructors

(:=) :: Expr e => Text -> e -> Attribute a infix 0 
(::=) :: (Expr k, Expr v) => k -> v -> Attribute Dynamic 
NoAttribute :: Attribute a 

Instances

String manipulation

match :: Expr string => ReQL -> string -> ReQL Source

Match a string to a regular expression.

>>> run' h $ str "foobar" # match "f(.)+[bc](.+)"
{"groups":[{"start":2,"end":3,"str":"o"},{"start":4,"end":6,"str":"ar"}],"start":0,"end":6,"str":"foobar"}

upcase :: Expr str => str -> ReQL Source

Convert to upper case

>>> run h $ upcase (str "Foo")
"FOO"

downcase :: Expr str => str -> ReQL Source

Convert to lower case

>>> run h $ downcase (str "Foo")
"foo"

split :: Expr str => str -> ReQL Source

Split a string on whitespace characters

>>> run' h $ split (str "foo bar")
["foo","bar"]

splitOn :: Expr str => ReQL -> str -> ReQL Source

Split a string on a given delimiter

>>> run' h $ str "foo, bar" # splitOn ","
["foo"," bar"]
>>> run' h $ str "foo" # splitOn ""
["f","o","o"]

splitMax :: Expr str => ReQL -> ReQL -> str -> ReQL Source

Split a string up to a given number of times

>>> run' h $ str "a:b:c:d" # splitMax ":" 2
["a","b","c:d"]

Math and logic

(+) :: (Expr a, Expr b) => a -> b -> ReQL infixl 6 Source

Addition or concatenation

Use the Num instance, or a qualified operator.

>>> run h $ 2 + 5
7
>>> run h $ str "foo" R.+ str "bar"
"foobar"

(-) :: (Expr a, Expr b) => a -> b -> ReQL infixl 6 Source

Subtraction

>>> run h $ 2 - 5
-3

(*) :: (Expr a, Expr b) => a -> b -> ReQL infixl 7 Source

Multiplication

>>> run h $ 2 * 5
10

(/) :: (Expr a, Expr b) => a -> b -> ReQL infixl 7 Source

Division

>>> run h $ 2 R./ 5
0.4

mod :: (Expr a, Expr b) => a -> b -> ReQL Source

Mod

>>> run h $ 5 `mod` 2
1

(&&) :: (Expr a, Expr b) => a -> b -> ReQL infixr 3 Source

Boolean and

>>> run h $ True R.&& False
false

(||) :: (Expr a, Expr b) => a -> b -> ReQL infixr 2 Source

Boolean or

>>> run h $ True R.|| False
true

(==) :: (Expr a, Expr b) => a -> b -> ReQL infix 4 Source

Test for equality

>>> run h $ ["a" := 1] R.== ["a" := 1]
true

(/=) :: (Expr a, Expr b) => a -> b -> ReQL infix 4 Source

Test for inequality

>>> run h $ 1 R./= False
true

(>) :: (Expr a, Expr b) => a -> b -> ReQL infix 4 Source

Greater than

>>> run h $ 3 R.> 2
true

(>=) :: (Expr a, Expr b) => a -> b -> ReQL infix 4 Source

Greater than or equal to

>>> run h $ [1] R.>= Null
false

(<) :: (Expr a, Expr b) => a -> b -> ReQL infix 4 Source

Lesser than

>>> run h $ (str "a") R.< (str "b")
true

(<=) :: (Expr a, Expr b) => a -> b -> ReQL infix 4 Source

Lesser than or equal to

>>> run h $ 2 R.<= 2
true

not :: Expr a => a -> ReQL Source

Negation

>>> run h $ R.not False
true
>>> run h $ R.not Null
true

random :: ReQL Source

A random float between 0 and 1

>>> run' h $ (\x -> x R.< 1 R.&& x R.>= 0) `apply` [random]
true

randomTo :: ReQL -> ReQL Source

A random number between 0 and n

>>> run' h $ (\x -> x R.< 10 R.&& x R.>= 0) `apply` [randomTo 10]
true

randomFromTo :: ReQL -> ReQL -> ReQL Source

A random number between 0 and n

>>> run' h $ (\x -> x R.< 10 R.&& x R.>= 5) `apply` [randomFromTo 5 10]
true

floor :: Expr s => s -> ReQL Source

Floor rounds number to interger below

>>> run h $ R.floor 2.9
2

ceil :: Expr s => s -> ReQL Source

Ceil rounds number to integer above

>>> run h $ R.ceil 2.1
3

round :: Expr s => s -> ReQL Source

Round rounds number to nearest integer

>>> run h $ R.round 2.5
3

Dates and times

now :: ReQL Source

The time and date when the query is executed

>>> run' h $ now

time :: ReQL -> ReQL -> ReQL -> ReQL -> ReQL -> ReQL -> ReQL -> ReQL Source

Build a time object from the year, month, day, hour, minute, second and timezone fields

>>> run' h $ time 2011 12 24 23 59 59 "Z"
Time<2011-12-24 23:59:59 +0000>

epochTime :: ReQL -> ReQL Source

Build a time object given the number of seconds since the unix epoch

>>> run' h $ epochTime 1147162826
Time<2006-05-09 08:20:26 +0000>

iso8601 :: ReQL -> ReQL Source

Build a time object given an iso8601 string

>>> run' h $ iso8601 "2012-01-07T08:34:00-0700"
Time<2012-01-07 08:34:00 -0700>

inTimezone :: Expr time => ReQL -> time -> ReQL Source

The same time in a different timezone

>>> _ <- run' h $ inTimezone "+0800" now

during :: (Expr left, Expr right, Expr time) => Bound left -> Bound right -> time -> ReQL Source

Test if a time is between two other times

>>> run' h $ during (Open $ now R.- (60*60)) (Closed now) $ epochTime 1382919271
false

timezone :: Expr time => time -> ReQL Source

Extract part of a time value

date :: Expr time => time -> ReQL Source

Extract part of a time value

timeOfDay :: Expr time => time -> ReQL Source

Extract part of a time value

year :: Expr time => time -> ReQL Source

Extract part of a time value

month :: Expr time => time -> ReQL Source

Extract part of a time value

day :: Expr time => time -> ReQL Source

Extract part of a time value

dayOfWeek :: Expr time => time -> ReQL Source

Extract part of a time value

dayOfYear :: Expr time => time -> ReQL Source

Extract part of a time value

hours :: Expr time => time -> ReQL Source

Extract part of a time value

minutes :: Expr time => time -> ReQL Source

Extract part of a time value

seconds :: Expr time => time -> ReQL Source

Extract part of a time value

toIso8601 :: Expr t => t -> ReQL Source

Convert a time to another representation

toEpochTime :: Expr t => t -> ReQL Source

Convert a time to another representation

Control structures

args :: Expr array => array -> ReQL Source

Splice a list of values into an argument list

apply :: (Expr fun, Expr arg) => fun -> [arg] -> ReQL Source

Apply a function to a list of arguments.

Called do in the official drivers

>>> run h $ (\x -> x R.* 2) `apply` [4]
8

js :: ReQL -> ReQL Source

Evaluate a JavaScript expression

>>> run' h $ js "Math.PI"
3.141592653589793
>>> let r_sin x = js "Math.sin" `apply` [x]
>>> run h $ R.map r_sin [pi, pi/2]
[1.2246...,1]

branch :: (Expr a, Expr b, Expr c) => a -> b -> c -> ReQL Source

Server-side if

>>> run h $ branch (1 R.< 2) 3 4
3

forEach :: (Expr a, Expr s) => (ReQL -> a) -> s -> ReQL Source

Like map but for write queries

>>> _ <- run' h $ table "users" # replace (without ["post_count"])
>>> run h $ forEach (\user -> table "users" # get (user!"name") # ex update [nonAtomic] (const ["post_count" := R.count (table "posts" # R.filter (\post -> post!"author" R.== user!"name"))])) (table "users") :: IO WriteResponse
{replaced:2}

range :: ReQL -> ReQL Source

Generate numbers starting from 0

>>> run h $ range 10
[0,1,2,3,4,5,6,7,8,9]

rangeFromTo :: ReQL -> ReQL -> ReQL Source

Generate numbers within a range

>>> run h $ rangeFromTo 2 4
[2,3]

rangeAll :: ReQL Source

Generate numbers starting from 0

>>> run' h $ rangeAll # limit 4
[0,1,2,3]

error :: Expr s => s -> ReQL Source

Abort the query with an error

>>> run' h $ R.error (str "haha") R./ 2 + 1
*** Exception: RethinkDB: Runtime error: "haha"
  in add(div({- HERE -} error("haha"), 2), 1)

handle :: (Expr instead, Expr reql) => (ReQL -> instead) -> reql -> ReQL Source

Catch some expections inside the query.

Called default in the official drivers

>>> run h $ R.handle (const 0) $ ["a" := 1] ! "b"
0
>>> run h $ R.handle (expr . id) $ ["a" := 1] ! "b"
"No attribute `b` in object:\n{\n\t\"a\":\t1\n}"

class Expr e where Source

Convert other types into ReQL expressions

Minimal complete definition

Nothing

Methods

expr :: e -> ReQL Source

exprList :: [e] -> ReQL Source

Instances

Expr Bool Source 
Expr Char Source 
Expr Double Source 
Expr Float Source 
Expr Int Source 
Expr Int8 Source 
Expr Int16 Source 
Expr Int32 Source 
Expr Int64 Source 
Expr Integer Source 
Expr Word Source 
Expr Word8 Source 
Expr Word16 Source 
Expr Word32 Source 
Expr Word64 Source 
Expr () Source 
Expr ByteString Source 
Expr ByteString Source 
Expr Text Source 
Expr UTCTime Source 
Expr Value Source 
Expr Text Source 
Expr ZonedTime Source 
Expr LonLat Source 
Expr Datum Source 
Expr Table Source 
Expr Database Source 
Expr ReQL Source 
Expr Term Source 
Expr Unit Source 
Expr ConflictResolution Source 
Expr Durability Source 
Expr PaginationStrategy Source 
Expr HttpMethod Source 
Expr HttpResultFormat Source 
Expr a => Expr [a] Source 
Expr (Ratio Integer) Source 
Expr a => Expr (Maybe a) Source 
Expr a => Expr (Set a) Source 
Expr a => Expr (Vector a) Source 
Expr a => Expr (Bound a) Source 
Expr (Attribute a) Source 
((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL, (~) * e ReQL) => Expr (a -> b -> c -> d -> e -> ReQL) Source 
((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL) => Expr (a -> b -> c -> d -> ReQL) Source 
((~) * a ReQL, (~) * b ReQL, (~) * c ReQL) => Expr (a -> b -> c -> ReQL) Source 
((~) * a ReQL, (~) * b ReQL) => Expr (a -> b -> ReQL) Source 
(~) * a ReQL => Expr (a -> ReQL) Source 
(Expr a, Expr b) => Expr (Either a b) Source 
(Expr a, Expr b) => Expr (a, b) Source 
Expr a => Expr (HashMap [Char] a) Source 
(Expr k, Expr v) => Expr (HashMap k v) Source 
Expr a => Expr (HashMap Text a) Source 
Expr a => Expr (Map [Char] a) Source 
Expr a => Expr (Map Text a) Source 
(Expr a, Expr b, Expr c) => Expr (a, b, c) Source 
(Expr a, Expr b, Expr c, Expr d) => Expr (a, b, c, d) Source 
(Expr a, Expr b, Expr c, Expr d, Expr e) => Expr (a, b, c, d, e) Source 

coerceTo :: Expr x => ReQL -> x -> ReQL Source

Convert a value to a different type

>>> run h $ coerceTo "STRING" 1
"1"

asArray :: Expr x => x -> ReQL Source

Convert a value to an array

>>> run h $ asArray $ ["a" := 1, "b" := 2] :: IO [(String, Int)]
[("a",1),("b",2)]

asString :: Expr x => x -> ReQL Source

Convert a value to a string

>>> run h $ asString $ ["a" := 1, "b" := 2]
"{\"a\":1,\"b\":2}"

asNumber :: Expr x => x -> ReQL Source

Convert a value to a number

>>> run h $ asNumber (str "34")
34

asObject :: Expr x => x -> ReQL Source

Convert a value to an object

>>> run' h $ asObject $ [(str "a",1),("b",2)]
{"a":1,"b":2}

asBool :: Expr x => x -> ReQL Source

Convert a value to a boolean

typeOf :: Expr a => a -> ReQL Source

A string representing the type of an expression

>>> run h $ typeOf 1
"NUMBER"

info :: Expr a => a -> ReQL Source

Get information on a given expression. Useful for tables and databases.

>>> run h $ info $ table "users"
{"primary_key":"name","doc_count_estimates":...,"name":"users","id":...,"indexes":["friends","location"],"type":"TABLE","db":{"name":"doctests","id":...,"type":"DB"}}

json :: ReQL -> ReQL Source

Parse a json string into an object

>>> run' h $ json "{\"a\":1}"
{"a":1}

toJSON :: Expr a => a -> ReQL Source

Convert an object or value to a JSON string

>>> run h $ toJSON "a"
"\"a\""

uuid :: ReQL Source

Generate a UUID

>>> run h uuid
"...-...-...-..."

uuid5 :: Expr name => name -> ReQL Source

Generate a Version 5 UUID

>>> run h $ uuid5 "foo"
"aa32a020-8c2d-5ff1-823b-ad3fa5d067eb"

http :: Expr url => url -> HttpOptions -> ReQL Source

Retrieve data from the specified URL over HTTP

>>> _ <- run' h $ http "http://httpbin.org/get" def{ httpParams = Just ["foo" := 1] }
>>> _ <- run' h $ http "http://httpbin.org/put" def{ httpMethod = Just PUT, httpData = Just $ expr ["foo" := "bar"] }

Geospatial commands

circle :: (Expr point, Expr radius) => point -> radius -> ReQL Source

Create a polygon approximating a circle

>>> run' h $ ex circle [numVertices 6, unit Kilometer] (point (-73) 40) 100
Polygon<[[-73,39.099310036015424],[-74.00751390838496,39.54527799206398],[-74.02083610406069,40.445812561599965],[-73,40.900549591978255],[-71.97916389593931,40.445812561599965],[-71.99248609161504,39.54527799206398],[-73,39.099310036015424]]>

distance :: (Expr a, Expr b) => a -> b -> ReQL Source

Distance between a point and another geometry object

run' h $ distance (point (-73) 40) (point (-122) 37)
  1. 467303546 > run' h $ ex distance [unit Mile] (point (-73) 40) (point (-122) 37)
  2. 5460282596796

fill :: Expr line => line -> ReQL Source

Convert a line object into a polygon

>>> run' h $ fill $ line [[-122,37], [-120,39], [-121,38]]
Polygon<[[-122,37],[-120,39],[-121,38],[-122,37]]>

geoJSON :: Expr geojson => geojson -> ReQL Source

Convert a GeoJSON object into a RethinkDB geometry object

>>> run' h $ geoJSON ["type" := "Point", "coordinates" := [-45,80]]
Point<-45,80>

toGeoJSON :: Expr geo => geo -> ReQL Source

Convert a RethinkDB geometry object into a GeoJSON object

>>> run' h $ toGeoJSON $ point (-122.423246) 37.779388
{"coordinates":[-122.423246,37.779388],"type":"Point"}

getIntersecting :: (Expr geo, Expr table) => geo -> Index -> table -> ReQL Source

Search a geospatial index for intersecting objects

>>> run' h $ table "places" # getIntersecting (point (-122) 37) (Index "geo")
[]

getNearest :: (Expr point, Expr table) => point -> Index -> table -> ReQL Source

Query a geospatial index for the nearest matches

>>> run' h $ table "places" # getNearest (point (-122) 37) (Index "location")
[]
>>> run' h $ table "places" # ex getNearest [maxResults 5, maxDist 10, unit Kilometer] (point (-122) 37) (Index "location")
[]

includes :: (Expr area, Expr geo) => geo -> area -> ReQL Source

Test whether a geometry object includes another

>>> run' h $ circle (point (-122) 37) 5000 # includes (point (-120) 48)
false

intersects :: (Expr a, Expr b) => a -> b -> ReQL Source

Test if two geometry objects intersects

>>> run' h $ intersects (line [[-122,37],[-120,48]]) (line [[-120,49],[-122,48]])
false

line :: Expr points => points -> ReQL Source

Create a line object

>>> run' h $ line [[-73,45],[-122,37]]
Line<[-73,45],[-122,37]>

point :: (Expr longitude, Expr latitude) => longitude -> latitude -> ReQL Source

Create a point objects

>>> run' h $ point (-73) 40
Point<-73,40>

polygon :: Expr points => points -> ReQL Source

Create a polygon object

>>> run' h $ polygon [[-73,45],[-122,37],[-73,40]]
Polygon<[[-73,45],[-122,37],[-73,40],[-73,45]]>

polygonSub :: (Expr polygon, Expr hole) => hole -> polygon -> ReQL Source

Punch a hole in a polygon

>>> run' h $ (polygon [[-73,45],[-122,37],[-73,40]]) # polygonSub (polygon [[-73.2,40.1],[-73.2,40.2],[-73.3,40.1]])
Polygon<[[-73,45],[-122,37],[-73,40],[-73,45]],[[-73.2,40.1],[-73.2,40.2],[-73.3,40.1],[-73.2,40.1]]>

maxResults :: ReQL -> Attribute a Source

Optional argument for getNearest

maxDist :: ReQL -> Attribute a Source

Optional argument for getNearest

unit :: Unit -> Attribute a Source

Optional argument for getNearest, circle and distance

numVertices :: ReQL -> Attribute a Source

Optional argument for circle

data Unit Source

Instances

Administration

config :: Expr table => table -> ReQL Source

Get the config for a table or database

>>> run h $ table "users" # config
{"primary_key":"name","write_acks":"majority","durability":"hard","name":"users","shards":...,"id":...,"db":"doctests"}

rebalance :: Expr table => table -> ReQL Source

Rebalance a table's shards

>>> run h $ table "users" # rebalance
{"rebalanced":1,"status_changes":[{"new_val":{"status":{"all_replicas_ready":...,"ready_for_outdated_reads":...

reconfigure :: (Expr table, Expr replicas) => ReQL -> replicas -> table -> ReQL Source

Change a table's configuration

>>> run h $ table "users" # reconfigure 2 1
{"config_changes":[{"new_val":{"primary_key":"name","write_acks":"majority","durability":"hard","name":"users","shards":...

status :: Expr table => table -> ReQL Source

Get the status of a table

>>> run h $ table "users" # status
{"status":{"all_replicas_ready":true,"ready_for_outdated_reads":true,...

wait :: Expr table => table -> ReQL Source

Wait for tables to be ready

>>> run h $ table "users" # wait
{"ready":1}

Helpers

ex :: OptArgs a => a -> [Attribute Static] -> a Source

Extend an operation with optional arguments

str :: String -> ReQL Source

A shortcut for inserting strings into ReQL expressions Useful when OverloadedStrings makes the type ambiguous

num :: Double -> ReQL Source

A shortcut for inserting numbers into ReQL expressions

(#) :: (Expr a, Expr b) => a -> (a -> b) -> ReQL infixl 8 Source

Flipped function application

note :: String -> ReQL -> ReQL Source

Add a note a a ReQL Term

This note does not get sent to the server. It is used to annotate backtraces and help debugging.

empty :: ReQL Source

An empty object

def :: Default a => a

The default value for this type.