postgresql-orm-0.3.2: An ORM (Object Relational Mapping) and migrations DSL for PostgreSQL.

Safe HaskellTrustworthy
LanguageHaskell2010

Database.PostgreSQL.ORM.DBSelect

Contents

Synopsis

The DBSelect structure

data DBSelect a Source

A deconstructed SQL select statement that allows easier manipulation of individual terms. Several functions are provided to combine the selFields, selFrom, and selWhere clauses of muliple DBSelect structures. Other clauses may be discarded when combining queries with join operations. Hence it is advisable to set the other clauses at the end (or, if you set these fields, to collapse your DBSelect structure into a subquery using dbProject').

Constructors

DBSelect 

Fields

selWith :: !Query
 
selSelectKeyword :: !Query

By default "SELECT", but might usefully be set to something else such as "SELECT DISTINCT" in some situations.

selFields :: Query
 
selFrom :: !FromClause
 
selWhereKeyword :: !Query

Empty by default, but set to "WHERE" if any WHERE clauses are added to the selWhere field.

selWhere :: !Query
 
selGroupBy :: !Query
 
selHaving :: !Query
 
selOrderBy :: !Query
 
selLimit :: !Query
 
selOffset :: !Query
 

Instances

Show (DBSelect a) 
Generic (DBSelect a) 
type Rep (DBSelect a) 

data FromClause Source

As it's name would suggest, a FromClause is the part of a query between the FROM keyword and the WHERE keyword. It can consist of simple table names, JOIN operations, and parenthesized subqueries.

From clauses are represented in a more structured way than the other fields so as to allow the possibility of collapsing join relations. For instance, given a DBSelect (A :. B) and a DBSelect (B :. C), it is desirable to be able to generate a DBSelect (A :. B :. C) in which each pair of terms involving B in the three-way relation is constrained according to the original two queries. This functionality is provided by dbNest and dbChain, but it requires the ability to locate and replace the instance of type B in one DBSelect with the FromClause of the other DBSelect.

The fcCanonical field is a canonical name of each type, which by convention is the quoted and fully-qualified table name. Comparing fcCanonical is somewhat of a hack, and happens entirely at runtime. It would be nicer to do this at compile time, but doing so would require language extensions such as GADTs of FunctionalDependencies.

Constructors

FromModel 

Fields

fcVerbatim :: !Query

Verbatim SQL for a table, table AS alias, or parenthesized subquery.

fcCanonical :: !ByteString

Canonical name of the table or join relation represented by this term. For JOIN terms, this is always the CROSS JOIN of the canonical names of fcLeft and fcRight. This means one can locate a join given only it's type (e.g., the canonical name for A :. B is always "a CROSS JOIN b"), but it does mean you have to be careful not accidentally to merge two different joins on the same types. For this reason it may be safest always to have type b be a single table in dbNest and dbChain.

FromJoin 

Fields

fcLeft :: !FromClause
 
fcJoinOp :: !Query

Usually "JOIN"

fcRight :: !FromClause
 
fcOnClause :: !Query

ON or USING clause (or empty)

fcCanonical :: !ByteString

Canonical name of the table or join relation represented by this term. For JOIN terms, this is always the CROSS JOIN of the canonical names of fcLeft and fcRight. This means one can locate a join given only it's type (e.g., the canonical name for A :. B is always "a CROSS JOIN b"), but it does mean you have to be careful not accidentally to merge two different joins on the same types. For this reason it may be safest always to have type b be a single table in dbNest and dbChain.

Instances

Executing DBSelects

dbSelectParams :: (Model a, ToRow p) => DBSelect a -> Connection -> p -> IO [a] Source

Run a DBSelect query on parameters. The number of '?' characters embedeed in various fields of the DBSelect must exactly match the number of fields in parameter type p. Note the order of arguments is such that the DBSelect can be pre-rendered and the parameters supplied later. Hence, you should use this version when the DBSelect is static. For dynamically modified DBSelect structures, you may prefer dbSelect.

dbSelect :: Model a => Connection -> DBSelect a -> IO [a] Source

Run a DBSelect query and return the resulting models.

data Cursor a Source

Datatype that represents a connected cursor

Constructors

Cursor 

curSelect :: Model a => Connection -> DBSelect a -> IO (Cursor a) Source

Create a Cursor for the given DBSelect

curNext :: Model a => Cursor a -> IO (Maybe a) Source

Fetch the next Model for the underlying Cursor. If the cache has prefetched values, dbNext will return the head of the cache without querying the database. Otherwise, it will prefetch the next 256 values, return the first, and store the rest in the cache.

dbFold :: Model model => Connection -> (b -> model -> b) -> b -> DBSelect model -> IO b Source

Streams results of a DBSelect and consumes them using a left-fold. Uses default settings for Cursor (batch size is 256 rows).

dbFoldM :: (MonadIO m, Model model) => Connection -> (b -> model -> m b) -> b -> DBSelect model -> m b Source

Streams results of a DBSelect and consumes them using a monadic left-fold. Uses default settings for Cursor (batch size is 256 rows).

dbFoldM_ :: (MonadIO m, Model model) => Connection -> (model -> m ()) -> DBSelect model -> m () Source

Streams results of a DBSelect and consumes them using a monadic left-fold. Uses default settings for Cursor (batch size is 256 rows).

dbCollect :: (Model a, Model b) => Connection -> DBSelect (a :. b) -> IO [(a, [b])] Source

Group the returned tuples by unique a's. Expects the query to return a's in sequence -- all rows with the same value for a must be grouped together, for example, by sorting the result on a's primary key column.

renderDBSelect :: DBSelect a -> Query Source

Turn a DBSelect into a Query suitable for the query or query_ functions.

buildDBSelect :: DBSelect a -> Builder Source

Create a Builder for a rendered version of a DBSelect. This can save one string copy if you want to embed one query inside another as a subquery, as done by dbProject', and thus need to parenthesize it. However, the function is probably not a useful for end users.

Creating DBSelects

emptyDBSelect :: DBSelect a Source

A DBSelect structure with keyword "SELECT" and everything else empty.

expressionDBSelect :: Model r => Query -> DBSelect r Source

A DBSelect for one or more comma-separated expressions, rather than for a table. For example, to issue the query "SELECT lastval()":

lastval :: DBSelect (Only DBKeyType)
lastval = expressionDBSelect "lastval ()"

  ...
  [just_inserted_id] <- dbSelect conn lastval

On the other hand, for such a simple expression, you might as well call query_ directly.

modelDBSelect :: forall a. Model a => DBSelect a Source

A DBSelect that returns all rows of a model.

dbJoin Source

Arguments

:: (Model a, Model b) 
=> DBSelect a

First table

-> Query

Join keyword ("JOIN", "LEFT JOIN", etc.)

-> DBSelect b

Second table

-> Query

Predicate (if any) including ON or USING keyword

-> DBSelect (a :. b) 

Create a join of the selFields, selFrom, and selWhere clauses of two DBSelect queries. Other fields are simply taken from the second DBSelect, meaning fields such as selWith, selGroupBy, and selOrderBy in the in the first DBSelect are entirely ignored.

dbJoinModels Source

Arguments

:: (Model a, Model b) 
=> Query

Join keyword

-> Query

ON or USING predicate

-> DBSelect (a :. b) 

A version of dbJoin that uses modelDBSelect for the joined tables.

dbProject :: forall a something_containing_a. Model a => DBSelect something_containing_a -> DBSelect a Source

Restrict the fields returned by a DBSelect to be those of a single Model a. It only makes sense to do this if a is part of something_containing_a, but no static check is performed that this is the case. If you dbProject a type that doesn't make sense, you will get a runtime error from a failed database query.

dbProject' :: forall a something_containing_a. Model a => DBSelect something_containing_a -> DBSelect a Source

Like dbProject, but renders the entire input DBSelect as a subquery. Hence, you can no longer mention fields of models other than a that might be involved in joins. The two advantages of this approach are 1) that you can once again join to tables that were part of the original query without worrying about row aliases, and 2) that all terms of the DBSelect will be faithrully rendered into the subquery (whereas otherwise they could get dropped by join operations). Generally you will still want to use dbProject, but dbProject' is available when needed.

dbNest :: forall a b c. (Model a, Model b) => DBSelect (a :. b) -> DBSelect (b :. c) -> DBSelect (a :. (b :. c)) Source

Nest two type-compatible JOIN queries. As with dbJoin, fields of the first JOIN (the DBSelect (a :. b)) other than selFields, selFrom, and selWhere are entirely ignored.

dbChain :: (Model a, Model b, Model c) => DBSelect (a :. b) -> DBSelect (b :. c) -> DBSelect (a :. c) Source

Like dbNest, but projects away the middle type b.

Altering DBSelects

addWhere_ :: Query -> DBSelect a -> DBSelect a Source

Add a where clause verbatim to a DBSelect. The clause must not contain the WHERE keyword (which is added automatically by addWhere_ if needed). If the DBSelect has existing WHERE clauses, the new clause is appended with AND. If the query contains any '?' characters, they will be rendered into the query and matching parameters will later have to be filled in via a call to dbSelectParams.

addWhere :: ToRow p => Query -> p -> DBSelect a -> DBSelect a Source

Add a where clause, and pre-render parameters directly into the clause. The argument p must have exactly as many fields as there are '?' characters in the Query. Example:

bars <- dbSelect c $ addWhere "bar_id = ?" (Only target_id) $
                     (modelDBSelect :: DBSelect Bar)

setOrderBy :: Query -> DBSelect a -> DBSelect a Source

Set the ORDER BY clause of a DBSelect. Example:

dbSelect c $ setOrderBy "\"employeeName\" DESC NULLS FIRST" $
               modelDBSelect

setLimit :: Int -> DBSelect a -> DBSelect a Source

Set the LIMIT clause of a DBSelect.

setOffset :: Int -> DBSelect a -> DBSelect a Source

Set the OFFSET clause of a DBSelect.

addExpression :: Model r => Query -> DBSelect a -> DBSelect (a :. r) Source

Add one or more comma-separated expressions to selFields that produce column values without any corresponding relation in the FROM clause. Type r is the type into which the expression is to be parsed. Generally this will be an instance of FromRow that is a degenerate model (e.g., Only, or a tuple).

For example, to rank results by the field value and compute the fraction of overall value they contribute:

r <- dbSelect c $ addExpression
       "rank() OVER (ORDER BY value), value::float4/SUM(value) OVER ()"
       modelDBSelect
         :: IO [Bar :. (Int, Double)]