rethinkdb-wereHamster-1.8.0.5: RethinkDB driver for Haskell

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

data RethinkDBHandle Source

A connection to the database server

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

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

close :: RethinkDBHandle -> IO () Source

Close an open connection

use :: RethinkDBHandle -> Database -> RethinkDBHandle Source

Set the default database

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

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

Run a given query and return a Result

run' :: Expr query => RethinkDBHandle -> query -> IO [JSON] Source

Run a given query and return a JSON

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

Run a query with the given options

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

data RunOptions Source

Per-query settings

data Cursor a Source

Instances

data Response Source

The raw response to a query

class Result r where Source

Convert the raw query response into useful values

Instances

data ReQL Source

An RQL term

Instances

Num ReQL 
Show ReQL 
IsString ReQL 
Expr ReQL 
((~) * a ReQL, (~) * b ReQL) => Expr (a -> b -> ReQL) 
(~) * a ReQL => Expr (a -> ReQL) 

data JSON Source

Constructors

JSON Value 

Instances

Manipulating databases

data Database Source

A database, referenced by name

Constructors

Database 

Fields

databaseName :: Text
 

db :: Text -> Database Source

Create a Database reference

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

dbCreate :: String -> ReQL Source

Create a database on the server

>>> run' h $ dbCreate "dev"
[{"created":1.0}]

dbDrop :: Database -> ReQL Source

Drop a database

>>> run' h $ dbDrop (db "dev")
[{"dropped":1.0}]

dbList :: ReQL Source

List the databases on the server

>>> run h $ dbList :: IO (Maybe [String])
Just ["test"]

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
 

data TableCreateOptions Source

Options used to create a table

data IndexCreateOptions Source

Options used to create an index

Constructors

IndexCreateOptions 

Fields

indexMulti :: Maybe Bool
 

table :: Text -> Table Source

A table

>>> (mapM_ print =<<) $ run' h $ table "users"
{"post_count":0.0,"name":"nancy","id":"8d674d7a-873c-4c0f-8a4a-32a4bd5bdee8"}
{"post_count":1.0,"name":"bob","id":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c"}
{"post_count":2.0,"name":"bill","id":"b2908215-1d3c-4ff5-b9ee-1a003fa9690c"}

tableCreate :: Table -> TableCreateOptions -> ReQL Source

Create a table on the server

>>> run' h $ tableCreate (table "posts") def
>>> run' h $ tableCreate (table "users") def
>>> run' h $ tableCreate (Table (db "prod") "bar" (Just "name")) def{ tableDataCenter = Just "cloud", tableCacheSize = Just 10 }

tableDrop :: Table -> ReQL Source

Drop a table

>>> run' h $ tableDrop (table "bar")
[{"dropped":1.0}]

tableList :: Database -> ReQL Source

List the tables in a database

>>> run h $ tableList (db "test") :: IO (Maybe [String])
Just ["foo","posts","users"]

indexCreate :: Expr fun => String -> fun -> IndexCreateOptions -> Table -> ReQL Source

Create an index on the table from the given function

>>> run' h $ table "users" # indexCreate "name" (!"name") def
[{"created":1.0}]

indexDrop :: Key -> Table -> ReQL Source

Drop an index

>>> run' h $ table "users" # indexDrop "name"
[{"dropped":1.0}]

indexList :: Table -> ReQL Source

List the indexes on the table

>>> run' h $ indexList (table "users")
[["name"]]

Writing data

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

Insert a document or a list of documents into a table

>>> Just wr@WriteResponse{} <- run h $ table "users" # insert (map (\x -> obj ["name":=x]) ["bill", "bob", "nancy" :: Text])
>>> let Just [bill, bob, nancy] = writeResponseGeneratedKeys wr
>>> run' h $ table "posts" # insert (obj ["author" := bill, "message" := str "hi"])
>>> run' h $ table "posts" # insert (obj ["author" := bill, "message" := str "hello"])
>>> run' h $ table "posts" # insert (obj ["author" := bob, "message" := str "lorem ipsum"])

upsert :: (Expr table, Expr object) => object -> table -> ReQL Source

Like insert, but update existing documents with the same primary key

>>> run' h $ table "users" # upsert (obj ["id" := "79bfe377-9593-402a-ad47-f94c76c36a51", "name" := "rupert"])
[{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":1.0,"errors":0.0}]

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 $ obj ["name" := str "benjamin"])
[{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":1.0,"errors":0.0}]

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

Replace a document with another

>>> run' h $ replace (\bill -> obj ["name" := str "stoyan", "id" := bill!"id"]) . R.filter ((R.== str "bill") . (!"name")) $ table "users"
[{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":1.0,"errors":0.0}]

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

Delete the documents

>>> run' h $ delete . getAll "name" [str "bob"] $ table "users"
[{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":1.0,"replaced":0.0,"errors":0.0}]

returnVals :: ReQL -> ReQL Source

Include the value of single write operations in the returned object

nonAtomic :: ReQL -> ReQL Source

Allow non-atomic replace

Selecting data

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
 

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

Get a document by primary key

>>> run' h $ table "users" # get "8d674d7a-873c-4c0f-8a4a-32a4bd5bdee8"
[{"post_count":0.0,"name":"nancy","id":"8d674d7a-873c-4c0f-8a4a-32a4bd5bdee8"}]

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] :: IO (Maybe [Int])
Just [3,1,1,2]

between :: (Expr left, Expr right, Expr seq) => Key -> 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 "id" (Closed $ str "a") (Open $ str "n") :: IO [JSON]
[{"post_count":4.0,"name":"bob","id":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c"},{"post_count":4.0,"name":"bill","id":"b2908215-1d3c-4ff5-b9ee-1a003fa9690c"}]

getAll :: Expr value => Key -> [value] -> Table -> ReQL Source

Retreive documents by their indexed value

>>> run' h $ table "users" # getAll "name" ["bob"]
[{"post_count":1.0,"name":"bob","id":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c"}]

Joins

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

SQL-like inner join of two sequences

>>> run' h $ innerJoin (\user post -> user!"id" R.== post!"author") (table "users") (table "posts") # mergeLeftRight # without ["id", "author"]
[[{"name":"bob","message":"lorem ipsum"},{"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

>>> run' h $ outerJoin (\user post -> user!"id" R.== post!"author") (table "users") (table "posts") # mergeLeftRight # without ["id", "author"]
[[{"name":"nancy"},{"name":"bill","message":"hello"},{"name":"bill","message":"hi"},{"name":"bob","message":"lorem ipsum"}]]

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

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

>>> run' h $ table "posts" # eqJoin "author" (table "users") "id" # mergeLeftRight # without ["id", "author"]
[[{"name":"bill","message":"hi"},{"name":"bob","message":"lorem ipsum"},{"name":"bill","message":"hello"}]]

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

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

Called zip in the official drivers

>>> run' h $ table "posts" # eqJoin "author" (table "users") "id" # mergeLeftRight

Transformations

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

Map a function over a sequence

>>> run h $ R.map (!"a") [obj ["a" := 1], obj ["a" := 2]] :: IO (Maybe [Int])
Just [1,2]

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

Like hasFields followed by pluck

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

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]] :: IO (Maybe [Int])
Just [1,2,3,4,5]

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

Drop elements from the head of a sequence.

Called skip in the official drivers

>>> run h $ R.drop 2 [1, 2, 3, 4] :: IO (Maybe [Int])
Just [3,4]

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

Limit the size of a sequence.

Called limit in the official drivers

>>> run h $ R.take 2 [1, 2, 3, 4] :: IO (Maybe [Int])
Just [1,2]

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

Get the nth value of a sequence or array

>>> run h $ [1, 2, 3] !! 0 :: IO (Maybe Int)
Just 1

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] :: IO (Maybe [Int])
Just [3,4]

orderBy :: Expr s => [Order] -> 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.0,"name":"bill"},{"post_count":1.0,"name":"bob"},{"name":"nancy"}]]

data Order Source

Ordering specification for orderBy

Constructors

Asc

Ascending order

Fields

orderAttr :: Key
 
Desc

Descending order

Fields

orderAttr :: Key
 

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

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

>>> run h $ indexesOf (=~ "ba.") [str "foo", "bar", "baz"] :: IO (Maybe [Int])
Just [1,2]

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

Test if a sequence is empty

>>> run h $ isEmpty [1] :: IO (Maybe Bool)
Just False

(++) :: (Expr a, Expr b) => a -> b -> ReQL infixr 5 Source

Join two sequences.

Called union in the official drivers

>>> run h $ [1,2,3] R.++ ["a", "b", "c" :: Text] :: IO (Maybe [JSON])
Just [1.0,2.0,3.0,"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] :: IO (Maybe [Int])
Just [4,3,8]

Aggregation

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

Reduce a sequence to a single value

>>> run h $ reduce (+) 0 [1, 2, 3] :: IO (Maybe Int)
Just 6

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

Reduce a non-empty sequence to a single value

>>> run h $ reduce1 (+) [1, 2, 3] :: IO (Maybe Int)
Just 6

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

Filter out identical elements of the sequence

Called distint in the official drivers

>>> run h $ nub (table "posts" ! "flag") :: IO (Maybe [String])
Just ["pinned", "deleted"]

groupBy :: (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" # groupBy (!"author") (reduce1 (\a b -> a + "\n" + b) . R.map (!"message"))
[[{"group":"b2908215-1d3c-4ff5-b9ee-1a003fa9690c","reduction":"hi\nhello"},{"group":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c","reduction":"lorem ipsum"}]]
>>> run' h $ table "users" # groupBy (!"level") (\users -> let pc = users!"post_count" in [avg pc, R.sum pc])
[[{"group":1,"reduction":[1.5,3.0]},{"group":2,"reduction":[0.0,0.0]}]]

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

Test if a sequence contains a given element

>>> run' h $ 1 `R.elem` [1,2,3]
[true]

Aggregators

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

The size of a sequence or an array.

Called count in the official drivers

>>> run h $ R.length (table "foo") :: IO (Maybe Int)
Just 17

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

The sum of a sequence

>>> run h $ sum [1, 2, 3] :: IO (Maybe Int)
Just 6

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

The average of a sequence

>>> run h $ avg [1, 2, 3, 4] :: IO (Maybe Double)
Just 2.5

Document manipulation

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

Keep only the given attributes

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

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

Remove the given attributes from an object

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

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

Merge two objects together

>>> run' h $ merge (obj ["a" := 1, "b" := 1]) (obj ["b" := 2, "c" := 2])
[{"a":1.0,"b":2.0,"c":2.0}]

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

Append a datum to a sequence

>>> run h $ append 3 [1, 2] :: IO (Maybe [Int])
Just [1,2,3]

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

Prepend an element to an array

>>> run h $ prepend 1 [2,3] :: IO (Maybe [Int])
Just [1,2,3]

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

Called difference in the official drivers

>>> run h $ [1,2,3,4,5] \\ [2,5] :: IO (Maybe [Int])
Just [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] :: IO (Maybe [Int])
Just [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]  :: IO (Maybe [Int])
Just [2,3,1]

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

The intersection of two sets

>>> run h $ [1,2] `setIntersection` [2,3]  :: IO (Maybe [Int])
Just [2]

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

The difference of two sets

>>> run h $ [2,3] # setDifference [1,2]  :: IO (Maybe [Int])
Just [3]

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

Get a single field from an object

>>> run h $ (obj ["foo" := True]) ! "foo" :: IO (Maybe Bool)
Just True

Or a single field from each object in a sequence

>>> run h $ [obj ["foo" := True], obj ["foo" := False]] ! "foo" :: IO (Maybe [Bool])
Just [True,False]

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

Test if an object has the given fields

>>> run h $ hasFields ["a"] $ obj ["a" := 1] :: IO (Maybe Bool)
Just 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] :: IO (Maybe [Int])
Just [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] :: IO (Maybe [Int])
Just [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] :: IO (Maybe [Int])
Just [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] :: IO (Maybe [Int])
Just [1,4,3]

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

The list of keys of the given object

>>> run h $ keys (obj ["a" := 1, "b" := 2]) :: IO (Maybe [String])
Just ["a","b"]

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 :: IO (Maybe Int)
Just 7
>>> run h $ 2 R.+ 5 :: IO (Maybe Int)
Just 7
>>> run h $ (str "foo") + (str "bar") :: IO (Just String)
Just "foobar"

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

Subtraction

>>> run h $ 2 - 5 :: IO (Maybe Int)
Just (-3)

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

Multiplication

>>> run h $ 2 * 5 :: IO (Maybe Int)
Just 10

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

Division

>>> run h $ 2 R./ 5 :: IO (Maybe Double)
Just 0.4

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

Mod

>>> run h $ 5 `mod` 2 :: IO (Maybe Int)
Just 1

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

Boolean and

>>> run h $ True R.&& False :: IO (Maybe Bool)
Just False

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

Boolean or

>>> run h $ True R.|| False :: IO (Maybe Bool)
Just True

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

Test for equality

>>> run h $ obj ["a" := 1] R.== obj ["a" := 1] :: IO (Maybe Bool)
Just True

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

Test for inequality

>>> run h $ 1 R./= False :: IO (Maybe Bool)
Just True

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

Greater than

>>> run h $ 3 R.> 2 :: IO (Maybe Bool)
Just True

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

Lesser than

>>> run h $ (str "a") R.< (str "b") :: IO (Maybe Bool)
Just True

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

Lesser than or equal to

>>> run h $ 2 R.<= 2 :: IO (Maybe Bool)
Just True

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

Greater than or equal to

>>> run h $ [1] R.>= () :: IO (Maybe Bool)
Just False

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

Negation

>>> run h $ R.not False :: IO (Maybe Bool)
Just True
>>> run h $ R.not () :: IO (Maybe Bool)
Just True

String manipulation

(=~) :: Expr string => string -> ReQL -> ReQL Source

Match a string to a regular expression.

Called match in the official drivers

>>> run' h $ str "foobar" =~ "f(.)+[bc](.+)"
[{"groups":[{"start":2.0,"end":3.0,"str":"o"},{"start":4.0,"end":6.0,"str":"ar"}],"start":0.0,"end":6.0,"str":"foobar"}]

Dates and times

newtype UTCTime Source

Time with no time zone

The default FromJSON instance for Data.Time.UTCTime is incompatible with ReQL's time type

Constructors

UTCTime UTCTime 

newtype ZonedTime Source

Time with a time zone

The default FromJSON instance for Data.Time.ZonedTime is incompatible with ReQL's time type

Constructors

ZonedTime ZonedTime 

now :: ReQL Source

The time and date when the query is executed

>>> run h $ now :: IO (Maybe R.ZonedTime)
Just 2013-10-28 00:01:43.930000066757 +0000

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" :: IO (Maybe R.ZonedTime)
Just 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 :: IO (Maybe R.ZonedTime)
Just 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" :: IO (Maybe R.UTCTime)
Just 2012-01-07 15:34:00 UTC

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

The same time in a different timezone

>>> run h $ inTimezone "+0800" now :: IO (Maybe R.ZonedTime)
Just 2013-10-28 08:16:39.22000002861 +0800

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 - (60*60)) (Closed now) $ epochTime 1382919271 :: IO (Maybe Bool)
Just True

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

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] :: IO (Maybe Int)
Just 8

js :: ReQL -> ReQL Source

Evaluate a JavaScript expression

>>> run h $ js "Math.random()" :: IO (Maybe Double)
Just 0.9119815775193274
>>> run h $ R.map (\x -> js "Math.sin" `apply` [x]) [pi, pi/2] :: IO (Maybe [Double])
Just [1.2246063538223773e-16,1.0]

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

Called branch in the official drivers

>>> run h $ if' (1 R.< 2) 3 4 :: IO (Maybe Int)
Just 3

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

Like map but for write queries

>>> run' h $ table "users" # replace (without ["post_count"])
>>> run' h $ forEach (table "posts") $ \post -> table "users" # get (post!"author") # update (\user -> obj ["post_count" := (handle 0 (user!"post_count") + 1)])
[{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":3.0,"errors":0.0}]

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

Abort the query with an error

>>> run' h $ R.error (str "haha") R./ 2 + 1
*** Exception: RethinkDBError {errorCode = runtime error, errorTerm = ADD(DIV(ERROR("haha"), 2.0), 1.0), errorMessage = "haha", errorBacktrace = [0,0]}

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

Catch some expections inside the query.

Called default in the official drivers

>>> run h $ handle 0 $ obj ["a" := 1] ! "b" :: IO (Maybe Int)
Just 0
>>> run h $ handle (expr . id) $ obj ["a" := 1] ! "b" :: IO (Maybe String)
Just "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

Instances

Expr Bool 
Expr Double 
Expr Int 
Expr Int64 
Expr Integer 
Expr Rational 
Expr () 
Expr Text 
Expr UTCTime 
Expr Value 
Expr ZonedTime 
Expr Datum 
Expr Table 
Expr Database 
Expr Object 
Expr BaseReQL 
Expr ReQL 
Expr ZonedTime 
Expr UTCTime 
Expr a => Expr [a] 
Expr x => Expr (Vector x) 
((~) * a ReQL, (~) * b ReQL) => Expr (a -> b -> ReQL) 
(~) * a ReQL => Expr (a -> ReQL) 
(Expr a, Expr b) => Expr (a, b) 
Expr e => Expr (HashMap Text e) 
(Expr a, Expr b, Expr c) => Expr (a, b, c) 
(Expr a, Expr b, Expr c, Expr d) => Expr (a, b, c, d) 
(Expr a, Expr b, Expr c, Expr d, Expr e) => Expr (a, b, c, d, e) 

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

Convert a value to a different type

>>> run h $ coerceTo "STRING" 1 :: IO (Maybe String)
Just "1"

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

Convert a value to an array

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

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

Convert a value to a string

>>> run h $ asString $ obj ["a" := 1, "b" := 2] :: IO (Maybe String)
Just "{\n\t\"a\":\t1,\n\t\"b\":\t2\n}"

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

Convert a value to a number

>>> run h $ asNumber (str "34") :: IO (Maybe Int)
Just 34

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

Convert a value to an object

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

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 :: IO (Maybe String)
Just "NUMBER"

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

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

>>> run' h $ info $ table "foo"
[{"primary_key":"id","name":"foo","indexes":[],"type":"TABLE","db":{"name":"test","type":"DB"}}]

json :: ReQL -> ReQL Source

Parse a json string into an object

>>> run' h $ json "{a:1}"
[{"a":1.0}]

Helpers

class Obj o where Source

Convert into a ReQL object

Methods

obj :: o -> Object Source

Instances

data Object Source

A list of key/value pairs

Instances

data Attribute Source

A key/value pair used for building objects

Constructors

forall e . Expr e => Text := e infix 0 

Instances

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, Expr c) => (ReQL -> b) -> (ReQL -> a) -> c -> ReQL infixr 9 Source

Specialised function composition

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

Flipped function application

def :: Default a => a

The default value for this type.