Takusen-0.8: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.

Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org

Database.InternalEnumerator

Contents

Description

This is the interface between the middle Enumerator layer and the low-level, Database-specific layer. This file is not exported to the end user.

Only the programmer for a new back-end needs to consult this file.

Synopsis

Session object.

class ISession sess whereSource

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.

Session objects per se are created by database connection/login functions.

The class ISession is thus an interface between low-level (and database-specific) code and the Enumerator, database-independent code. The ISession class is NOT visible to the end user -- neither the class, nor any of its methods.

The ISession class describes the mapping from connection object to the session object. The connection object is created by the end user (and this is how the end user tells which particular back end he wants). The session object is not accessible by the end user in any way. Even the type of the session object should be hidden!

Methods

disconnect :: sess -> IO ()Source

beginTransaction :: sess -> IsolationLevel -> IO ()Source

commit :: sess -> IO ()Source

rollback :: sess -> IO ()Source

newtype 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 Database.Enumerator.Sqlite.connect function is to pass it out directly to Database.Enumerator.withSession.

Constructors

ConnectA (IO sess) 

Instances

class ISession sess => Statement stmt sess q | stmt sess -> q whereSource

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

Methods

makeQuery :: sess -> stmt -> IO qSource

Instances

Statement String Session Query 
Statement String Session Query 
Statement String Session Query 
Statement String Session Query 
Statement QueryStringTuned Session Query 
Statement QueryString Session Query 
Statement StmtBind Session Query 
Statement BoundStmt Session Query 
Statement PreparedStmtObj Session Query 
Statement QueryString Session Query 
Statement QueryStringTuned Session Query 
Statement BoundStmt Session Query 
Statement PreparedStmtObj Session Query 
Statement QueryString Session Query 
Statement QueryStringTuned Session Query 
Statement BoundStmt Session Query 
Statement QueryString Session Query 
Statement StmtBind Session Query 
Statement BoundStmt Session Query 
Statement PreparedStmtObj Session Query 
Statement QueryString Session Query 
Statement (RefCursor String) Session Query 
Statement (RefCursor StmtHandle) Session Query 
Statement (NextResultSet mark PreparedStmtObj) Session Query 
Statement (NextResultSet mark PreparedStmtObj) Session Query 

class ISession sess => Command stmt sess whereSource

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

Methods

executeCommand :: sess -> stmt -> IO IntSource

Instances

Command String Session 
Command String Session 
Command String Session 
Command String Session 
Command QueryStringTuned Session 
Command QueryString Session 
Command StmtBind Session 
Command BoundStmt Session 
Command QueryString Session 
Command BoundStmt Session 
Command CommandBind Session 
Command QueryString Session 
Command BoundStmt Session 
Command CommandBind Session 
Command QueryString Session 
Command StmtBind Session 
Command BoundStmt Session 
Command QueryString Session 

class ISession sess => EnvInquiry inquirykey sess result | inquirykey sess -> result whereSource

Methods

inquire :: inquirykey -> sess -> IO resultSource

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

Why don't we make a user-visible class with a prepare method? Because it means to standardize the preparation method signature across all databases. Some databases need more parameters, some fewer. There may be several statement preparation functions within one database. So, instead of standardizing the signature of the preparation function, we standardize on the _result_ of that function. To be more precise, we standardize on the properties of the result: whatever it is, the eventual prepared statement should be suitable to be passed to bindRun.

Constructors

PreparationA (sess -> IO stmt) 

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

Methods

bindRun :: sess -> stmt -> [BindA sess stmt bo] -> (bound_stmt -> IO a) -> IO aSource

destroyStmt :: sess -> stmt -> IO ()Source

Instances

IPrepared PreparedStmtObj Session BoundStmt BindObj 
IPrepared PreparedStmtObj Session BoundStmt BindObj 
IPrepared PreparedStmtObj Session BoundStmt BindObj 
IPrepared PreparedStmtObj Session BoundStmt BindObj 

newtype 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).

Constructors

BindA (sess -> stmt -> bo) 

class ISession sess => DBBind a sess stmt bo | stmt -> bo whereSource

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.

Methods

bindP :: a -> BindA sess stmt boSource

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

Instances

DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj 
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj 
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj 
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj 
DBBind (Maybe Double) Session PreparedStmtObj BindObj 
DBBind (Maybe Double) Session PreparedStmtObj BindObj 
DBBind (Maybe Double) Session PreparedStmtObj BindObj 
DBBind (Maybe Double) Session PreparedStmtObj BindObj 
DBBind (Maybe Float) Session PreparedStmtObj BindObj 
DBBind (Maybe Int) Session PreparedStmtObj BindObj 
DBBind (Maybe Int) Session PreparedStmtObj BindObj 
DBBind (Maybe Int) Session PreparedStmtObj BindObj 
DBBind (Maybe Int) Session PreparedStmtObj BindObj 
DBBind (Maybe Int64) Session PreparedStmtObj BindObj 
DBBind (Maybe Int64) Session PreparedStmtObj BindObj 
DBBind (Maybe String) Session PreparedStmtObj BindObj 
DBBind (Maybe String) Session PreparedStmtObj BindObj 
DBBind (Maybe String) Session PreparedStmtObj BindObj 
DBBind (Maybe String) Session PreparedStmtObj BindObj 
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj 
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj 
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj 
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj 
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj 
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj 
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj 
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj 
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj 
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj 
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj 
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj 
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj 
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj 
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj 
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj 
DBBind (Out (Maybe StmtHandle)) Session PreparedStmtObj BindObj 

class ISession sess => IQuery q sess b | q -> sess, q -> b whereSource

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

Can a session have several types of query objects? Let's assume that it can: but a statement plus the session uniquely determine the query,

Note that we explicitly use IO monad because we will have to explicitly do FFI.

Instances

IQuery Query Session ColumnBuffer 
IQuery Query Session ColumnBuffer 
IQuery Query Session ColumnBuffer 
IQuery Query Session ColumnBuffer 
IQuery Query Session ColumnBuffer 

class DBType a q b | q -> b whereSource

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.

Different DBMS's (that is, different session objects) have, in general, columnBuffers of different types: the type of Column Buffer is specific to a database. So, ISession (m) uniquely determines the buffer type (b)?? Or, actually, a query uniquely determines the buffer.

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.

Methods

allocBufferFor :: a -> q -> Position -> IO bSource

fetchCol :: q -> b -> IO aSource

Instances

DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer 
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer

This single polymorphic instance replaces all of the type-specific non-Maybe instances e.g. String, Int, Double, etc.

DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer

This single polymorphic instance covers all of the type-specific non-Maybe instances e.g. String, Int, Double, etc.

DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer

This single polymorphic instance replaces all of the type-specific non-Maybe instances e.g. String, Int, Double, etc.

DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer

This single polymorphic instance replaces all of the type-specific non-Maybe instances e.g. String, Int, Double, etc.

DBType (Maybe Double) Query ColumnBuffer 
DBType (Maybe Double) Query ColumnBuffer 
DBType (Maybe Double) Query ColumnBuffer 
DBType (Maybe Double) Query ColumnBuffer 
DBType (Maybe Double) Query ColumnBuffer 
DBType (Maybe Float) Query ColumnBuffer 
DBType (Maybe Int) Query ColumnBuffer 
DBType (Maybe Int) Query ColumnBuffer 
DBType (Maybe Int) Query ColumnBuffer 
DBType (Maybe Int) Query ColumnBuffer 
DBType (Maybe Int) Query ColumnBuffer 
DBType (Maybe Int64) Query ColumnBuffer 
DBType (Maybe Int64) Query ColumnBuffer 
DBType (Maybe String) Query ColumnBuffer 
DBType (Maybe String) Query ColumnBuffer 
DBType (Maybe String) Query ColumnBuffer 
DBType (Maybe String) Query ColumnBuffer 
DBType (Maybe String) Query ColumnBuffer 
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer 
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer

This polymorphic instance assumes that the value is in a String column, and uses Read to convert the String to a Haskell data value.

(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer

A polymorphic instance which assumes that the value is in a String column, and uses Read to convert the String to a Haskell data value.

(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer

This polymorphic instance assumes that the value is in a String column, and uses Read to convert the String to a Haskell data value.

(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer

This polymorphic instance assumes that the value is in a String column, and uses Read to convert the String to a Haskell data value.

DBType (Maybe CalendarTime) Query ColumnBuffer 
DBType (Maybe CalendarTime) Query ColumnBuffer 
DBType (Maybe CalendarTime) Query ColumnBuffer 
DBType (Maybe CalendarTime) Query ColumnBuffer 
DBType (Maybe UTCTime) Query ColumnBuffer 
DBType (Maybe UTCTime) Query ColumnBuffer 
DBType (Maybe UTCTime) Query ColumnBuffer 
DBType (Maybe UTCTime) Query ColumnBuffer 
DBType (RefCursor String) Query ColumnBuffer 
DBType (RefCursor StmtHandle) Query ColumnBuffer 

throwIfDBNull :: Monad m => m (RowNum, ColNum) -> m (Maybe a) -> m aSource

Used by instances of DBType to throw an exception when a null (Nothing) is returned. Will work for any type, as you pass the fetch action in the fetcher arg.

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.

throwDB :: DBException -> aSource

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