rethinkdb-2.2.0.10: 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
["bob","nancy"]

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 # 

Methods

pi :: ReQL #

exp :: ReQL -> ReQL #

log :: ReQL -> ReQL #

sqrt :: ReQL -> ReQL #

(**) :: ReQL -> ReQL -> ReQL #

logBase :: ReQL -> ReQL -> ReQL #

sin :: ReQL -> ReQL #

cos :: ReQL -> ReQL #

tan :: ReQL -> ReQL #

asin :: ReQL -> ReQL #

acos :: ReQL -> ReQL #

atan :: ReQL -> ReQL #

sinh :: ReQL -> ReQL #

cosh :: ReQL -> ReQL #

tanh :: ReQL -> ReQL #

asinh :: ReQL -> ReQL #

acosh :: ReQL -> ReQL #

atanh :: ReQL -> ReQL #

log1p :: ReQL -> ReQL #

expm1 :: ReQL -> ReQL #

log1pexp :: ReQL -> ReQL #

log1mexp :: ReQL -> ReQL #

Fractional ReQL Source # 

Methods

(/) :: ReQL -> ReQL -> ReQL #

recip :: ReQL -> ReQL #

fromRational :: Rational -> ReQL #

Num ReQL Source # 

Methods

(+) :: ReQL -> ReQL -> ReQL #

(-) :: ReQL -> ReQL -> ReQL #

(*) :: ReQL -> ReQL -> ReQL #

negate :: ReQL -> ReQL #

abs :: ReQL -> ReQL #

signum :: ReQL -> ReQL #

fromInteger :: Integer -> ReQL #

Show ReQL Source # 

Methods

showsPrec :: Int -> ReQL -> ShowS #

show :: ReQL -> String #

showList :: [ReQL] -> ShowS #

IsString ReQL Source # 

Methods

fromString :: String -> ReQL #

Expr ReQL Source # 

Methods

expr :: ReQL -> ReQL Source #

exprList :: [ReQL] -> ReQL Source #

OptArgs ReQL Source # 

Methods

ex :: ReQL -> [Attribute Static] -> ReQL Source #

((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL, (~) * e ReQL) => Expr (a -> b -> c -> d -> e -> ReQL) Source # 

Methods

expr :: (a -> b -> c -> d -> e -> ReQL) -> ReQL Source #

exprList :: [a -> b -> c -> d -> e -> ReQL] -> ReQL Source #

((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL) => Expr (a -> b -> c -> d -> ReQL) Source # 

Methods

expr :: (a -> b -> c -> d -> ReQL) -> ReQL Source #

exprList :: [a -> b -> c -> d -> ReQL] -> ReQL Source #

((~) * a ReQL, (~) * b ReQL, (~) * c ReQL) => Expr (a -> b -> c -> ReQL) Source # 

Methods

expr :: (a -> b -> c -> ReQL) -> ReQL Source #

exprList :: [a -> b -> c -> ReQL] -> ReQL Source #

((~) * a ReQL, (~) * b ReQL) => Expr (a -> b -> ReQL) Source # 

Methods

expr :: (a -> b -> ReQL) -> ReQL Source #

exprList :: [a -> b -> ReQL] -> ReQL Source #

(~) * a ReQL => Expr (a -> ReQL) Source # 

Methods

expr :: (a -> ReQL) -> ReQL Source #

exprList :: [a -> ReQL] -> ReQL Source #

class ToDatum a where Source #

Methods

toDatum :: a -> Datum Source #

toDatum :: ToJSON a => a -> Datum Source #

Instances

ToDatum Bool Source # 

Methods

toDatum :: Bool -> Datum Source #

ToDatum Char Source # 

Methods

toDatum :: Char -> Datum Source #

ToDatum Double Source # 

Methods

toDatum :: Double -> Datum Source #

ToDatum Float Source # 

Methods

toDatum :: Float -> Datum Source #

ToDatum Int Source # 

Methods

toDatum :: Int -> Datum Source #

ToDatum Int8 Source # 

Methods

toDatum :: Int8 -> Datum Source #

ToDatum Int16 Source # 

Methods

toDatum :: Int16 -> Datum Source #

ToDatum Int32 Source # 

Methods

toDatum :: Int32 -> Datum Source #

ToDatum Int64 Source # 

Methods

toDatum :: Int64 -> Datum Source #

ToDatum Integer Source # 
ToDatum Word Source # 

Methods

toDatum :: Word -> Datum Source #

ToDatum Word8 Source # 

Methods

toDatum :: Word8 -> Datum Source #

ToDatum Word16 Source # 

Methods

toDatum :: Word16 -> Datum Source #

ToDatum Word32 Source # 

Methods

toDatum :: Word32 -> Datum Source #

ToDatum Word64 Source # 

Methods

toDatum :: Word64 -> Datum Source #

ToDatum () Source # 

Methods

toDatum :: () -> Datum Source #

ToDatum ByteString Source # 
ToDatum ByteString Source # 
ToDatum Text Source # 

Methods

toDatum :: Text -> Datum Source #

ToDatum UTCTime Source # 
ToDatum Value Source # 

Methods

toDatum :: Value -> Datum Source #

ToDatum Text Source # 

Methods

toDatum :: Text -> Datum Source #

ToDatum ZonedTime Source # 
ToDatum LonLat Source # 

Methods

toDatum :: LonLat -> Datum Source #

ToDatum Datum Source # 

Methods

toDatum :: Datum -> Datum Source #

ToDatum [Char] Source # 

Methods

toDatum :: [Char] -> Datum Source #

ToDatum a => ToDatum [a] Source # 

Methods

toDatum :: [a] -> Datum Source #

ToDatum a => ToDatum (Maybe a) Source # 

Methods

toDatum :: Maybe a -> Datum Source #

ToDatum (Ratio Integer) Source # 
ToDatum a => ToDatum (Set a) Source # 

Methods

toDatum :: Set a -> Datum Source #

ToDatum a => ToDatum (Vector a) Source # 

Methods

toDatum :: Vector a -> Datum Source #

(ToDatum a, ToDatum b) => ToDatum (Either a b) Source # 

Methods

toDatum :: Either a b -> Datum Source #

(ToDatum a, ToDatum b) => ToDatum (a, b) Source # 

Methods

toDatum :: (a, b) -> Datum Source #

ToDatum a => ToDatum (HashMap [Char] a) Source # 

Methods

toDatum :: HashMap [Char] a -> Datum Source #

ToDatum a => ToDatum (HashMap Text a) Source # 

Methods

toDatum :: HashMap Text a -> Datum Source #

ToDatum a => ToDatum (Map [Char] a) Source # 

Methods

toDatum :: Map [Char] a -> Datum Source #

ToDatum a => ToDatum (Map Text a) Source # 

Methods

toDatum :: Map Text a -> Datum Source #

(ToDatum a, ToDatum b, ToDatum c) => ToDatum (a, b, c) Source # 

Methods

toDatum :: (a, b, c) -> Datum Source #

(ToDatum a, ToDatum b, ToDatum c, ToDatum d) => ToDatum (a, b, c, d) Source # 

Methods

toDatum :: (a, b, c, d) -> Datum Source #

(ToDatum a, ToDatum b, ToDatum c, ToDatum d, ToDatum e) => ToDatum (a, b, c, d, e) Source # 

Methods

toDatum :: (a, b, c, d, e) -> Datum Source #

class FromDatum a where 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 () Source # 

Methods

parseDatum :: Datum -> Parser () Source #

FromDatum ByteString Source # 
FromDatum ByteString Source # 
FromDatum String 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 # 

Methods

parseDatum :: Datum -> Parser [a] Source #

FromDatum a => FromDatum (Maybe a) Source # 

Methods

parseDatum :: Datum -> Parser (Maybe a) Source #

FromDatum (Ratio Integer) Source # 
(Ord a, FromDatum a) => FromDatum (Set a) Source # 

Methods

parseDatum :: Datum -> Parser (Set a) Source #

FromDatum a => FromDatum (Vector a) Source # 
(FromDatum a, FromDatum b) => FromDatum (Either a b) Source # 

Methods

parseDatum :: Datum -> Parser (Either a b) Source #

(FromDatum a, FromDatum b) => FromDatum (a, b) Source # 

Methods

parseDatum :: Datum -> Parser (a, b) Source #

FromDatum a => FromDatum (HashMap [Char] a) Source # 
FromDatum a => FromDatum (HashMap Text a) Source # 
FromDatum a => FromDatum (Map [Char] a) Source # 

Methods

parseDatum :: Datum -> Parser (Map [Char] a) Source #

FromDatum a => FromDatum (Map Text a) Source # 
(FromDatum a, FromDatum b, FromDatum c) => FromDatum (a, b, c) Source # 

Methods

parseDatum :: Datum -> Parser (a, b, c) Source #

(FromDatum a, FromDatum b, FromDatum c, FromDatum d) => FromDatum (a, b, c, d) Source # 

Methods

parseDatum :: Datum -> Parser (a, b, c, d) Source #

(FromDatum a, FromDatum b, FromDatum c, FromDatum d, FromDatum e) => FromDatum (a, b, c, d, e) Source # 

Methods

parseDatum :: Datum -> Parser (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

Instances

Result Bool Source # 
Result Char Source # 
Result Double Source # 
Result Float Source # 
Result Int Source # 
Result Int8 Source # 
Result Int16 Source # 
Result Int32 Source # 
Result Int64 Source # 
Result Integer Source # 
Result Word Source # 
Result Word8 Source # 
Result Word16 Source # 
Result Word32 Source # 
Result Word64 Source # 
Result () Source # 
Result ByteString Source # 
Result ByteString Source # 
Result Text Source # 
Result UTCTime Source # 
Result Value Source # 
Result Text Source # 
Result ZonedTime Source # 
Result LonLat Source # 
Result Datum Source # 
Result Response Source # 
Result WriteResponse Source # 
FromDatum a => Result [a] Source # 
FromDatum a => Result (Maybe a) Source # 
Result (Ratio Integer) Source # 
(Ord a, FromDatum a) => Result (Set a) Source # 
FromDatum a => Result (Vector a) Source # 
FromDatum a => Result (Cursor a) Source # 
(FromDatum b, (~) * a RethinkDBError) => Result (Either a b) Source # 
(FromDatum a, FromDatum b) => Result (a, b) Source # 

Methods

convertResult :: MVar Response -> IO (a, b) Source #

FromDatum a => Result (HashMap [Char] a) Source # 
FromDatum a => Result (HashMap Text a) Source # 
FromDatum a => Result (Map [Char] a) Source # 
FromDatum a => Result (Map Text a) Source # 
(FromDatum a, FromDatum b, FromDatum c) => Result (a, b, c) Source # 

Methods

convertResult :: MVar Response -> IO (a, b, c) Source #

(FromDatum a, FromDatum b, FromDatum c, FromDatum d) => Result (a, b, c, d) Source # 

Methods

convertResult :: MVar Response -> IO (a, b, c, d) Source #

(FromDatum a, FromDatum b, FromDatum c, FromDatum d, FromDatum e) => Result (a, b, c, d, e) Source # 

Methods

convertResult :: MVar Response -> IO (a, b, c, d, e) Source #

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 #

data Cursor a Source #

Instances

Functor Cursor Source # 

Methods

fmap :: (a -> b) -> Cursor a -> Cursor b #

(<$) :: a -> Cursor b -> Cursor a #

FromDatum a => Result (Cursor a) Source # 

Manipulating databases

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

Instances

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

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

Closed

An exclusive bound

Fields

DefaultBound 

Fields

MinVal 
MaxVal 

Instances

Functor Bound Source # 

Methods

fmap :: (a -> b) -> Bound a -> Bound b #

(<$) :: a -> Bound b -> Bound a #

Num a => Num (Bound a) Source # 

Methods

(+) :: Bound a -> Bound a -> Bound a #

(-) :: Bound a -> Bound a -> Bound a #

(*) :: Bound a -> Bound a -> Bound a #

negate :: Bound a -> Bound a #

abs :: Bound a -> Bound a #

signum :: Bound a -> Bound a #

fromInteger :: Integer -> Bound a #

Expr a => Expr (Bound a) Source # 

Methods

expr :: Bound a -> ReQL Source #

exprList :: [Bound a] -> ReQL Source #

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]

nth :: (Expr a, Expr seq) => a -> seq -> ReQL Source #

Get nth element of a sequence

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

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

NOTE: This driver is based on the official JavaScript driver, you are correct to expect the same semantics. However the order of composition is flipped by putting the first argument last.

>>> 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

Methods

expr :: e -> ReQL Source #

expr :: ToDatum e => e -> ReQL Source #

exprList :: [e] -> ReQL Source #

Instances

Expr Bool Source # 

Methods

expr :: Bool -> ReQL Source #

exprList :: [Bool] -> ReQL Source #

Expr Char Source # 

Methods

expr :: Char -> ReQL Source #

exprList :: [Char] -> ReQL Source #

Expr Double Source # 
Expr Float Source # 
Expr Int Source # 

Methods

expr :: Int -> ReQL Source #

exprList :: [Int] -> ReQL Source #

Expr Int8 Source # 

Methods

expr :: Int8 -> ReQL Source #

exprList :: [Int8] -> ReQL Source #

Expr Int16 Source # 
Expr Int32 Source # 
Expr Int64 Source # 
Expr Integer Source # 
Expr Word Source # 

Methods

expr :: Word -> ReQL Source #

exprList :: [Word] -> ReQL Source #

Expr Word8 Source # 
Expr Word16 Source # 
Expr Word32 Source # 
Expr Word64 Source # 
Expr () Source # 

Methods

expr :: () -> ReQL Source #

exprList :: [()] -> ReQL Source #

Expr ByteString Source # 
Expr ByteString Source # 
Expr Text Source # 

Methods

expr :: Text -> ReQL Source #

exprList :: [Text] -> ReQL Source #

Expr UTCTime Source # 
Expr Value Source # 
Expr Text Source # 

Methods

expr :: Text -> ReQL Source #

exprList :: [Text] -> ReQL Source #

Expr ZonedTime Source # 
Expr Table Source # 
Expr Database Source # 
Expr ReQL Source # 

Methods

expr :: ReQL -> ReQL Source #

exprList :: [ReQL] -> ReQL Source #

Expr LonLat Source # 
Expr Datum Source # 
Expr Term Source # 

Methods

expr :: Term -> ReQL Source #

exprList :: [Term] -> ReQL Source #

Expr Unit Source # 

Methods

expr :: Unit -> ReQL Source #

exprList :: [Unit] -> ReQL Source #

Expr ConflictResolution Source # 
Expr PaginationStrategy Source # 
Expr HttpMethod Source # 
Expr HttpResultFormat Source # 
Expr Durability Source # 
Expr a => Expr [a] Source # 

Methods

expr :: [a] -> ReQL Source #

exprList :: [[a]] -> ReQL Source #

Expr a => Expr (Maybe a) Source # 

Methods

expr :: Maybe a -> ReQL Source #

exprList :: [Maybe a] -> ReQL Source #

Expr (Ratio Integer) Source # 
Expr a => Expr (Set a) Source # 

Methods

expr :: Set a -> ReQL Source #

exprList :: [Set a] -> ReQL Source #

Expr a => Expr (Vector a) Source # 

Methods

expr :: Vector a -> ReQL Source #

exprList :: [Vector a] -> ReQL Source #

Expr a => Expr (Bound a) Source # 

Methods

expr :: Bound a -> ReQL Source #

exprList :: [Bound a] -> ReQL Source #

Expr (Attribute a) Source # 
((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL, (~) * e ReQL) => Expr (a -> b -> c -> d -> e -> ReQL) Source # 

Methods

expr :: (a -> b -> c -> d -> e -> ReQL) -> ReQL Source #

exprList :: [a -> b -> c -> d -> e -> ReQL] -> ReQL Source #

((~) * a ReQL, (~) * b ReQL, (~) * c ReQL, (~) * d ReQL) => Expr (a -> b -> c -> d -> ReQL) Source # 

Methods

expr :: (a -> b -> c -> d -> ReQL) -> ReQL Source #

exprList :: [a -> b -> c -> d -> ReQL] -> ReQL Source #

((~) * a ReQL, (~) * b ReQL, (~) * c ReQL) => Expr (a -> b -> c -> ReQL) Source # 

Methods

expr :: (a -> b -> c -> ReQL) -> ReQL Source #

exprList :: [a -> b -> c -> ReQL] -> ReQL Source #

((~) * a ReQL, (~) * b ReQL) => Expr (a -> b -> ReQL) Source # 

Methods

expr :: (a -> b -> ReQL) -> ReQL Source #

exprList :: [a -> b -> ReQL] -> ReQL Source #

(~) * a ReQL => Expr (a -> ReQL) Source # 

Methods

expr :: (a -> ReQL) -> ReQL Source #

exprList :: [a -> ReQL] -> ReQL Source #

(Expr a, Expr b) => Expr (Either a b) Source # 

Methods

expr :: Either a b -> ReQL Source #

exprList :: [Either a b] -> ReQL Source #

(Expr a, Expr b) => Expr (a, b) Source # 

Methods

expr :: (a, b) -> ReQL Source #

exprList :: [(a, b)] -> ReQL Source #

Expr a => Expr (HashMap [Char] a) Source # 

Methods

expr :: HashMap [Char] a -> ReQL Source #

exprList :: [HashMap [Char] a] -> ReQL Source #

(Expr k, Expr v) => Expr (HashMap k v) Source # 

Methods

expr :: HashMap k v -> ReQL Source #

exprList :: [HashMap k v] -> ReQL Source #

Expr a => Expr (HashMap Text a) Source # 
Expr a => Expr (Map [Char] a) Source # 

Methods

expr :: Map [Char] a -> ReQL Source #

exprList :: [Map [Char] a] -> ReQL Source #

Expr a => Expr (Map Text a) Source # 

Methods

expr :: Map Text a -> ReQL Source #

exprList :: [Map Text a] -> ReQL Source #

(Expr a, Expr b, Expr c) => Expr (a, b, c) Source # 

Methods

expr :: (a, b, c) -> ReQL Source #

exprList :: [(a, b, c)] -> ReQL Source #

(Expr a, Expr b, Expr c, Expr d) => Expr (a, b, c, d) Source # 

Methods

expr :: (a, b, c, d) -> ReQL Source #

exprList :: [(a, b, c, d)] -> ReQL Source #

(Expr a, Expr b, Expr c, Expr d, Expr e) => Expr (a, b, c, d, e) Source # 

Methods

expr :: (a, b, c, d, e) -> ReQL Source #

exprList :: [(a, b, c, d, e)] -> ReQL 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.