takusen-oracle-0.9.4.1: Database library with left-fold interface for Oracle.

Copyright(c) 2004 Oleg Kiselyov, Alistair Bayley
LicenseBSD-style
Maintaineroleg@pobox.com, alistair@abayley.org
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Database.Enumerator

Contents

Description

 

Synopsis

Usage

 

Iteratee Functions

 

result and result'

 

Rank-2 types, ($), and the monomorphism restriction

 

Bind Parameters

 

Multiple (and nested) Result Sets

 

Sessions and Transactions

data ISession sess => DBM mark sess a Source #

Instances

MonadReader sess (DBM mark sess) Source # 

Methods

ask :: DBM mark sess sess

local :: (sess -> sess) -> DBM mark sess a -> DBM mark sess a

reader :: (sess -> a) -> DBM mark sess a

Monad (DBM mark sess) Source # 

Methods

(>>=) :: DBM mark sess a -> (a -> DBM mark sess b) -> DBM mark sess b #

(>>) :: DBM mark sess a -> DBM mark sess b -> DBM mark sess b #

return :: a -> DBM mark sess a #

fail :: String -> DBM mark sess a #

Functor (DBM mark sess) Source # 

Methods

fmap :: (a -> b) -> DBM mark sess a -> DBM mark sess b #

(<$) :: a -> DBM mark sess b -> DBM mark sess a #

MonadFix (DBM mark sess) Source # 

Methods

mfix :: (a -> DBM mark sess a) -> DBM mark sess a #

Applicative (DBM mark sess) Source # 

Methods

pure :: a -> DBM mark sess a #

(<*>) :: DBM mark sess (a -> b) -> DBM mark sess a -> DBM mark sess b #

(*>) :: DBM mark sess a -> DBM mark sess b -> DBM mark sess b #

(<*) :: DBM mark sess a -> DBM mark sess b -> DBM mark sess a #

MonadIO (DBM mark sess) Source # 

Methods

liftIO :: IO a -> DBM mark sess a #

ISession si => CaughtMonadIO (DBM mark si) Source # 

Methods

gcatch :: Exception e => DBM mark si a -> (e -> DBM mark si a) -> DBM mark si a Source #

gcatchJust :: Exception e => (e -> Maybe b) -> DBM mark si a -> (b -> DBM mark si a) -> DBM mark si a Source #

class ISession sess Source #

The ISession class describes a database session to a particular DBMS. Oracle has its own Session object, SQLite has its own session object (which maintains the connection handle to the database engine and other related stuff). Session objects for different databases normally have different types -- yet they all belong to the class ISession so we can do generic operations like commit, execDDL, etc. in a database-independent manner.

Minimal complete definition

disconnect, beginTransaction, commit, rollback

data ConnectA sess Source #

A wrapper around the action to open the database. That wrapper is not exported to the end user. The only reason for the wrapper is to guarantee that the only thing to do with the result of connect function is to pass it out directly to withSession.

withSession :: (Typeable a, ISession sess) => ConnectA sess -> (forall mark. DBM mark sess a) -> IO a Source #

Typeable constraint is to prevent the leakage of Session and other marked objects.

withContinuedSession :: (Typeable a, ISession sess) => ConnectA sess -> (forall mark. DBM mark sess a) -> IO (a, ConnectA sess) Source #

Persistent database connections. This issue has been brought up by Shanky Surana. The following design is inspired by that exchange.

commit :: ISession s => DBM mark s () Source #

rollback :: ISession s => DBM mark s () Source #

beginTransaction :: (MonadReader s (ReaderT s IO), ISession s) => IsolationLevel -> DBM mark s () Source #

withTransaction :: ISession s => IsolationLevel -> DBM mark s a -> DBM mark s a Source #

Perform an action as a transaction: commit afterwards, unless there was an exception, in which case rollback.

execDDL :: Command stmt s => stmt -> DBM mark s () Source #

DDL operations don't manipulate data, so we return no information. If there is a problem, an exception will be raised.

execDML :: Command stmt s => stmt -> DBM mark s Int Source #

Returns the number of rows affected.

inquire :: EnvInquiry key s result => key -> DBM mark s result Source #

Allows arbitrary actions to be run the DBM monad. The back-end developer must supply instances of EnvInquiry, which is hidden away in Database.InternalEnumerator. An example of this is LastInsertRowid.

Exceptions and handlers

data DBException Source #

Constructors

DBError SqlState Int String

DBMS error message.

DBFatal SqlState Int String 
DBUnexpectedNull RowNum ColNum

the iteratee function used for queries accepts both nullable (Maybe) and non-nullable types. If the query itself returns a null in a column where a non-nullable type was specified, we can't handle it, so DBUnexpectedNull is thrown.

DBNoData

Thrown by cursor functions if you try to fetch after the end.

basicDBExceptionReporter :: CaughtMonadIO m => DBException -> m () Source #

This simple handler reports the error to stdout and swallows it i.e. it doesn't propagate.

reportRethrow :: CaughtMonadIO m => DBException -> m a Source #

This handler reports the error and propagates it (usually to force the program to halt).

reportRethrowMsg :: CaughtMonadIO m => String -> DBException -> m a Source #

Same as reportRethrow, but you can prefix some text to the error (perhaps to indicate which part of your program raised it).

catchDB :: CaughtMonadIO m => m a -> (DBException -> m a) -> m a Source #

Catch DBExceptions thrown in the DBM monad.

catchDBError :: CaughtMonadIO m => Int -> m a -> (DBException -> m a) -> m a Source #

If you want to trap a specific error number, use this. It passes anything else up.

ignoreDBError :: CaughtMonadIO m => Int -> m a -> m a Source #

Analogous to catchDBError, but ignores specific errors instead (propagates anything else).

throwDB :: DBException -> a Source #

Throw a DBException. It's just a type-specific throwDyn.

Preparing and Binding

data PreparedStmt mark stmt Source #

withPreparedStatement Source #

Arguments

:: (Typeable a, IPrepared stmt sess bstmt bo) 
=> PreparationA sess stmt

preparation action to create prepared statement; this action is usually created by prepareQuery/Command

-> (PreparedStmt mark stmt -> DBM mark sess a)

DBM action that takes a prepared statement

-> DBM mark sess a 

Prepare a statement and run a DBM action over it. This gives us the ability to re-use a statement, for example by passing different bind values for each execution.

withBoundStatement Source #

Arguments

:: (Typeable a, IPrepared stmt s bstmt bo) 
=> PreparedStmt mark stmt

prepared statement created by withPreparedStatement

-> [BindA s stmt bo]

bind values

-> (bstmt -> DBM mark s a)

action to run over bound statement

-> DBM mark s a 

Applies a prepared statement to bind variables to get a bound statement, which is passed to the provided action. Note that by the time it is passed to the action, the query or command has usually been executed. A bound statement would normally be an instance of Statement, so it can be passed to doQuery in order to process the result-set, and also an instance of Command, so that we can write re-usable DML statements (inserts, updates, deletes).

class ISession sess => Statement stmt sess q | stmt sess -> q Source #

Statement defines the API for query objects i.e. which types can be queries.

Minimal complete definition

makeQuery

class ISession sess => Command stmt sess Source #

Command is not a query: command deletes or updates rows, creates/drops tables, or changes database state. executeCommand returns the number of affected rows (or 0 if DDL i.e. not DML).

Minimal complete definition

executeCommand

class ISession sess => EnvInquiry inquirykey sess result | inquirykey sess -> result Source #

Minimal complete definition

inquire

data PreparationA sess stmt Source #

This type is not visible to the end user (cf. ConnectA). It forms a private `communication channel' between Database.Enumerator and a back end.

class ISession sess => IPrepared stmt sess bound_stmt bo | stmt -> bound_stmt, stmt -> bo Source #

Minimal complete definition

bindRun, destroyStmt

data BindA sess stmt bo Source #

The binding object (bo) below is very abstract, on purpose. It may be |IO a|, it may be String, it may be a function, etc. The binding object can hold the result of marshalling, or bo can hold the current counter, etc. Different databases do things very differently: compare PostgreSQL and the Stub (which models Oracle).

class ISession sess => DBBind a sess stmt bo | stmt -> bo where Source #

The class DBBind is not used by the end-user. It is used to tie up low-level database access and the enumerator. A database-specific library must provide a set of instances for DBBind. The latter are the dual of DBType.

Minimal complete definition

bindP

Methods

bindP :: a -> BindA sess stmt bo Source #

This is really just a wrapper that lets us write lists of heterogenous bind values e.g. [bindP "string", bindP (0::Int), ...]

bindP :: DBBind a sess stmt bo => a -> BindA sess stmt bo Source #

This is really just a wrapper that lets us write lists of heterogenous bind values e.g. [bindP "string", bindP (0::Int), ...]

Iteratees and Cursors

class ISession sess => IQuery q sess b | q -> sess, q -> b where Source #

The class IQuery describes the class of query objects. Each database (that is, each Session object) has its own Query object. We may assume that a Query object includes (at least, conceptually) a (pointer to) a Session object, so a Query object determines the Session object. A back-end provides an instance (or instances) of IQuery. The end user never seens the IQuery class (let alone its methods).

Minimal complete definition

fetchOneRow, currentRowNum, freeBuffer, destroyQuery

Methods

currentRowNum :: q -> IO Int Source #

doQuery Source #

Arguments

:: (Statement stmt sess q, QueryIteratee (DBM mark sess) q i seed b, IQuery q sess b) 
=> stmt

query

-> i

iteratee function

-> seed

seed value

-> DBM mark sess seed 

The left-fold interface.

class DBType a q b | q -> b Source #

A 'buffer' means a column buffer: a data structure that points to a block of memory allocated for the values of one particular column. Since a query normally fetches a row of several columns, we typically deal with a list of column buffers. Although the column data are typed (e.g., Integer, CalendarDate, etc), column buffers hide that type. Think of the column buffer as Dynamics. The class DBType below describes marshalling functions, to fetch a typed value out of the 'untyped' columnBuffer.

The class DBType is not used by the end-user. It is used to tie up low-level database access and the enumerator. A database-specific library must provide a set of instances for DBType.

Minimal complete definition

allocBufferFor, fetchCol

type IterResult seedType = Either seedType seedType Source #

IterResult and IterAct give us some type sugar. Without them, the types of iteratee functions become quite unwieldy.

type IterAct m seedType = seedType -> m (IterResult seedType) Source #

currentRowNum :: IQuery q sess b => q -> IO Int Source #

data NextResultSet mark stmt Source #

Constructors

NextResultSet (PreparedStmt mark stmt) 

data RefCursor a Source #

Constructors

RefCursor a 

cursorIsEOF :: DBCursor mark (DBM mark s) a -> DBM mark s Bool Source #

cursorIsEOF's return value tells you if there are any more rows or not. If you call cursorNext when there are no more rows, a DBNoData exception is thrown. Cursors are automatically closed and freed when:

cursorCurrent :: DBCursor mark (DBM mark s) a -> DBM mark s a Source #

Returns the results fetched so far, processed by iteratee function.

cursorNext :: DBCursor mark (DBM mark s) a -> DBM mark s (DBCursor mark (DBM mark s) a) Source #

Advance the cursor. Returns the cursor. The return value is usually ignored.

withCursor Source #

Arguments

:: (Typeable a, Statement stmt sess q, QueryIteratee (DBM mark sess) q i seed b, IQuery q sess b) 
=> stmt

query

-> i

iteratee function

-> seed

seed value

-> (DBCursor mark (DBM mark sess) seed -> DBM mark sess a)

action taking cursor parameter

-> DBM mark sess a 

Ensures cursor resource is properly tidied up in exceptional cases. Propagates exceptions after closing cursor. The Typeable constraint is to prevent cursors and other marked values (like cursor computations) from escaping.

Utilities

ifNull Source #

Arguments

:: Maybe a

nullable value

-> a

value to substitute if first parameter is null i.e. Nothing

-> a 

Useful utility function, for SQL weenies.

result :: Monad m => IterAct m a Source #

Another useful utility function. Use this to return a value from an iteratee function (the one passed to doQuery). Note that you should probably nearly always use the strict version.

result' :: Monad m => IterAct m a Source #

A strict version. This is recommended unless you have a specific need for laziness, as the lazy version will gobble stack and heap. If you have a large result-set (in the order of 10-100K rows or more), it is likely to exhaust the standard 1M GHC stack. Whether or not result eats memory depends on what x does: if it's a delayed computation then it almost certainly will. This includes consing elements onto a list, and arithmetic operations (counting, summing, etc).