wxcore-0.12.1.5: wxHaskell core

Portabilityportable
Stabilityprovisional
Maintainerwxhaskell-devel@lists.sourceforge.net

Graphics.UI.WXCore.Db

Contents

Description

This module provides convenient access to the database classes (Db) of wxWindows. These classes have been donated to the wxWindows library by Remstar International. (Note: these classes are not supported on MacOS X at the time of writing (november 2003)). These database objects support ODBC connections and have been tested with wxWindows on the following databases:

Oracle (v7, v8, v8i), Sybase (ASA and ASE), MS SQL Server (v7 - minimal testing), MS Access (97 and 2000), MySQL, DBase (IV, V) (using ODBC emulation), PostgreSQL, INFORMIX, VIRTUOSO, DB2, Interbase, Pervasive SQL .

The database functions also work with console applications and do not need to initialize the WXCore libraries.

The examples in this document are all based on the pubs database that is available in MS Access 97 and 'comma separated text' format from http://wxhaskell.sourceforge.net/download/pubs.zip. We assume that your system is configured in such a way that pubs is the datasource name of this database. (On Windows XP for example, this is done using the /start - settings - control panel - administrative tools - data sources (ODBC)/ menu.)

The available data sources on your system can be retrieved using dbGetDataSources. Here is an example from my system:

 *Main> dbGetDataSources >>= print
 [("pubs","Microsoft Access Driver (*.mdb)")]

Connections are established with the dbWithConnection call. It takes a datasource name, a user name, a password, and a function that is applied to the resulting database connection:

 dbWithConnection "pubs" "" "" (\db -> ...)

(Note that most database operations automatically raise a database exception (DbError) on failure. These exceptions can be caught using catchDbError.)

The resulting database (Db) can be queried using dbQuery. The dbQuery call applies a function to each row (DbRow) in the result set. Using calls like dbRowGetValue and dbRowGetString, you can retrieve the values from the result rows.

 printAuthorNames
   = do names <- dbWithConnection "pubs" "" "" (\db ->
                  dbQuery db "SELECT au_fname, au_lname FROM authors" 
                    (\row -> do fname <- dbRowGetString row "au_fname"
                                lname <- dbRowGetString row "au_lname"
                                return (fname ++ " " ++ lname)
                    ))
        putStrLn (unlines names)

The overloaded function dbRowGetValue can retrieve any kind of database value (DbValue) (except for strings since standard Haskell98 does not support overlapping instances). For most datatypes, there is also a non-overloaded version, like dbRowGetInteger and dbRowGetString. The dbRowGet... functions are also available as dbRowGet...Mb, which returns Nothing when a NULL value is encountered (instead of raising an exception), for example, dbRowGetIntegerMb and dbRowGetStringMb.

If necessary, more data types can be supported by defining your own DbValue instances and using dbRowGetValue to retrieve those values.

You can use dbRowGetColumnInfo to retrieve column information (ColumnInfo) about a particular column, for example, to retieve the number of decimal digits in a currency value.

Complete meta information about a particular data source can be retrieved using dbGetDataSourceInfo, that takes a data source name, user name, and password as arguments, and returns a DbInfo structure:

 *Main> dbGetDataSourceInfo "pubs" "" "" >>= print
 catalog: C:\daan\temp\db\pubs2
 schema :
 tables :
  ...
  8: name   : authors
     type   : TABLE
     remarks:
     columns:
      1: name   : au_id
         index  : 1
         type   : VARCHAR
         size   : 12
         sqltp  : SqlVarChar
         type id: DbVarChar
         digits : 0
         prec   : 0
         remarks: Author Key
         pkey   : 0
         ptables: []
         fkey   : 0
         ftable :
      2: name   : au_fname
         index  : 2
         type   : VARCHAR
  ...

Changes to the database can be made using dbExecute. All these actions are done in transaction mode and are only comitted when wrapped with a dbTransaction.

Synopsis

Connection

dbWithConnection :: DataSourceName -> String -> String -> (Db () -> IO b) -> IO bSource

Open a (cached) connection and automatically close it after the computation returns. Takes the name of the data source, a user name, and password as arguments. Raises a database exception (DbError) when the connection fails.

dbConnect :: DataSourceName -> String -> String -> IO (Db ())Source

(dbConnect name userId password) creates a (cached) connection to a data source name. Raises a database exception (DbError) when the connection fails. Use dbDisconnect to close the connection.

dbDisconnect :: Db a -> IO ()Source

Closes a connection opened with dbConnect (or dbConnectDirect).

dbWithDirectConnection :: DataSourceName -> String -> String -> (Db () -> IO b) -> IO bSource

Open a direct database connection and automatically close it after the computation returns. This method is not recommended in general as -- the dbWithConnection function is potentially much more efficient since it -- caches database connections and meta information, greatly reducing network traffic.

dbConnectDirect :: DataSourceName -> String -> String -> IO (Db ())Source

Open a direct database connection. This method is in general not recommended as the dbConnect function is potentially much more efficient since it caches database connections and meta information, greatly reducing network traffic.

Queries

dbQuery :: Db a -> String -> (DbRow a -> IO b) -> IO [b]Source

Execute a SQL query against a database. Takes a function as argument that is applied to every database row (DbRow). The results of these applications are returned as a list. Raises a DbError on failure.

  do names <- dbQuery db "SELECT au_fname FROM authors" 
                (\row -> dbRowGetString row "au_fname")
     putStr (unlines names)

dbQuery_ :: Db a -> String -> (DbRow a -> IO b) -> IO ()Source

Execute a SQL query against a database. Takes a function as argument that is applied to every row in the database. Raises a DbError on failure.

  dbQuery_ db "SELECT au_fname FROM authors" 
    (\row -> do fname <- dbRowGetString row "au_fname"
                putStrLn fname)

Changes

dbExecute :: Db a -> String -> IO ()Source

Execute a SQL statement against the database. Raises a DbError on failure.

dbTransaction :: Db a -> IO b -> IO bSource

Execute an IO action as a transaction on a particular database. When no exception is raised, the changes to a database are committed. Always use this when using dbExecute statements that update the database.

 do dbWithConnection "pubs" "" "" $ \db -> 
     dbTransaction db $
       dbExecute db "CREATE TABLE TestTable ( TestField LONG)"

Rows

data DbRow a Source

An abstract database row.

Constructors

DbRow (Db a) [ColumnInfo] 

Standard values

dbRowGetString :: DbRow a -> ColumnName -> IO StringSource

Read a string value from the database. Returns the empty string when a NULL value is encountered. Raises a DbError on failure.

dbRowGetStringMb :: DbRow a -> ColumnName -> IO (Maybe String)Source

Read a string from the database. Returns Nothing when a NULL value is encountered. Raises a DbError on failure.

dbRowGetBool :: DbRow a -> ColumnName -> IO BoolSource

Read an Bool from the database. Raises a DbError on failure or when a NULL value is encountered.

dbRowGetBoolMb :: DbRow a -> ColumnName -> IO (Maybe Bool)Source

Read an Bool from the database. Returns Nothing when a NULL value is encountered. Raises a DbError on failure.

dbRowGetInt :: DbRow a -> ColumnName -> IO IntSource

Read an Int from the database. Raises a DbError on failure or when a NULL value is encountered.

dbRowGetIntMb :: DbRow a -> ColumnName -> IO (Maybe Int)Source

Read an Int from the database. Returns Nothing when a NULL value is encountered. Raises a DbError on failure.

dbRowGetDouble :: DbRow a -> ColumnName -> IO DoubleSource

Read an Double from the database. Raises a DbError on failure or when a NULL value is encountered.

dbRowGetDoubleMb :: DbRow a -> ColumnName -> IO (Maybe Double)Source

Read an Double from the database. Returns Nothing when a NULL value is encountered. Raises a DbError on failure.

dbRowGetInteger :: DbRow a -> ColumnName -> IO IntegerSource

Read an Integer from the database. Raises a DbError on failure or when a NULL value is encountered.

dbRowGetIntegerMb :: DbRow a -> ColumnName -> IO (Maybe Integer)Source

Read an Integer from the database. Returns Nothing when a NULL value is encountered. Raises a DbError on failure.

dbRowGetClockTime :: DbRow a -> ColumnName -> IO ClockTimeSource

Read an ClockTime from the database (from a SQL Time, TimeStamp, or Date field). Raises a DbError on failure or when a NULL value is encountered.

dbRowGetClockTimeMb :: DbRow a -> ColumnName -> IO (Maybe ClockTime)Source

Read an ClockTime from the database (from a SQL Time, TimeStamp, or Date field). Returns Nothing when a NULL value is encountered. Raises a DbError on failure.

Generic values

class DbValue a whereSource

Class of values that are supported by the database.

Methods

dbValueRead :: Db b -> ColumnInfo -> IO (Maybe a)Source

Read a value at a specified column from the database. Return Nothing when a NULL value is encountered Raises a DbError on failure. (dbGetDataNull can be used when implementing this behaviour).

toSqlValue :: a -> StringSource

Convert a value to a string representation that can be used directly in a SQL statement.

dbRowGetValue :: DbValue b => DbRow a -> ColumnName -> IO bSource

Get a database value (DbValue) from a row. Raises a DbError on failure or when a NULL value is encountered.

dbRowGetValueMb :: DbValue b => DbRow a -> ColumnName -> IO (Maybe b)Source

Get a database value (DbValue) from a row. Returns Nothing when a NULL value is encountered. Raises a DbError on failure.

Column information

dbRowGetColumnInfo :: DbRow a -> ColumnName -> IO ColumnInfoSource

The column information of a particular column. Raises a DbError on failure.

dbRowGetColumnInfos :: DbRow a -> [ColumnInfo]Source

Get the column information of a row.

Meta information

Data sources

dbGetDataSources :: IO [(DataSourceName, String)]Source

Returns the name and description of the data sources on the system.

dbGetDataSourceInfo :: DataSourceName -> String -> String -> IO DbInfoSource

Get the complete meta information of a data source. Takes the data source name, a user id, and password as arguments.

 dbGetDataSourceInfo dsn userid password
   = dbWithConnection dsn userId password dbGetInfo 

dbGetDataSourceTableInfo :: DataSourceName -> TableName -> String -> String -> IO TableInfoSource

Get the meta information of a table in a data source. Takes the data source name, table name, a user id, and password as arguments.

Tables and columns

type ColumnName = StringSource

Column names. Note that a column name consisting of a number can be used to retrieve a value by index, for example: dbGetString db "1".

data DbInfo Source

Database information.

Constructors

DbInfo 

Fields

dbCatalog :: String

System name of the database

dbSchema :: String

Schema name

dbTables :: [TableInfo]

The tables of the database

Instances

data TableInfo Source

Database table information.

Constructors

TableInfo 

Fields

tableName :: TableName

Name of the table.

tableType :: String

Type of the table (ie. SYSTEM TABLE, TABLE, etc)

tableRemarks :: String

Comments

tableColumns :: [ColumnInfo]

The columns of the table.

Instances

data ColumnInfo Source

Database column information.

Constructors

ColumnInfo 

Fields

columnName :: ColumnName

Column name.

columnIndex :: ColumnIndex

1-based column index.

columnSize :: Int

Length of the column.

columnNullable :: Bool

Are NULL values allowed?

columnType :: DbType

Logical type

columnSqlType :: SqlType

SQL type

columnTypeName :: String

SQL type name (ie. VARCHAR, INTEGER etc.)

columnRemarks :: String

Comments

columnDecimalDigits :: Int

Number of decimal digits

columnNumPrecRadix :: Int

Radix precision

columnForeignKey :: Int

Is this a foreign key column? 0 = no, 1 = first key, 2 = second key, etc. (not supported on all systems)

columnPrimaryKey :: Int

Is this a primary key column? 0 = no, 1 = first key, 2 = second key, etc. (not supported on all systems)

columnForeignKeyTableName :: TableName

Table that has this foreign key as a primary key.

columnPrimaryKeyTableNames :: [TableName]

Tables that use this primary key as a foreign key.

Instances

dbGetInfo :: Db a -> IO DbInfoSource

Get the complete meta information of a database.

dbGetTableInfo :: Db a -> TableName -> IO TableInfoSource

Get the meta information of a table in a database.

dbGetTableColumnInfos :: Db a -> TableName -> IO [ColumnInfo]Source

Return the column information of a certain table. Use an empty table name to get the column information of the current query (dbGetColumnInfos).

dbGetColumnInfos :: Db a -> IO [ColumnInfo]Source

Return the column information of the current query.

Dbms

dbGetDbms :: Db a -> IO DbmsSource

Retrieve the database backend system.

Exceptions

data DbError Source

Database error type.

Instances

catchDbError :: IO a -> (DbError -> IO a) -> IO aSource

Handle database errors.

raiseDbError :: DbError -> IO aSource

Raise a database error.

dbHandleExn :: Db a -> IO Bool -> IO ()Source

Automatically raise a database exception when False is returned. You can use this method around basic database methods to conveniently throw Haskell exceptions.

  dbHandleExn db $ dbExecSql db "SELECT au_fname FROM authors"           

dbCheckExn :: Db a -> IO ()Source

Raise a database exception based on the current error status of the database. Does nothing when no error is set.

dbRaiseExn :: Db a -> IO bSource

Raise a database exception based on the current error status of the database.

dbGetErrorMessages :: Db a -> IO [String]Source

Get the raw error message history. More recent error messages come first.

dbGetDbStatus :: Db a -> IO DbStatusSource

Retrieve the current status of the database

data DbStatus Source

Status of the database.

Constructors

DB_FAILURE

General failure.

DB_SUCCESS

No error.

DB_ERR_NOT_IN_USE 
DB_ERR_GENERAL_WARNING

SqlState = 01000

DB_ERR_DISCONNECT_ERROR

SqlState = 01002

DB_ERR_DATA_TRUNCATED

SqlState = 01004

DB_ERR_PRIV_NOT_REVOKED

SqlState = 01006

DB_ERR_INVALID_CONN_STR_ATTR

SqlState = 01S00

DB_ERR_ERROR_IN_ROW

SqlState = 01S01

DB_ERR_OPTION_VALUE_CHANGED

SqlState = 01S02

DB_ERR_NO_ROWS_UPD_OR_DEL

SqlState = 01S03

DB_ERR_MULTI_ROWS_UPD_OR_DEL

SqlState = 01S04

DB_ERR_WRONG_NO_OF_PARAMS

SqlState = 07001

DB_ERR_DATA_TYPE_ATTR_VIOL

SqlState = 07006

DB_ERR_UNABLE_TO_CONNECT

SqlState = 08001

DB_ERR_CONNECTION_IN_USE

SqlState = 08002

DB_ERR_CONNECTION_NOT_OPEN

SqlState = 08003

DB_ERR_REJECTED_CONNECTION

SqlState = 08004

DB_ERR_CONN_FAIL_IN_TRANS

SqlState = 08007

DB_ERR_COMM_LINK_FAILURE

SqlState = 08S01

DB_ERR_INSERT_VALUE_LIST_MISMATCH

SqlState = 21S01

DB_ERR_DERIVED_TABLE_MISMATCH

SqlState = 21S02

DB_ERR_STRING_RIGHT_TRUNC

SqlState = 22001

DB_ERR_NUMERIC_VALUE_OUT_OF_RNG

SqlState = 22003

DB_ERR_ERROR_IN_ASSIGNMENT

SqlState = 22005

DB_ERR_DATETIME_FLD_OVERFLOW

SqlState = 22008

DB_ERR_DIVIDE_BY_ZERO

SqlState = 22012

DB_ERR_STR_DATA_LENGTH_MISMATCH

SqlState = 22026

DB_ERR_INTEGRITY_CONSTRAINT_VIOL

SqlState = 23000

DB_ERR_INVALID_CURSOR_STATE

SqlState = 24000

DB_ERR_INVALID_TRANS_STATE

SqlState = 25000

DB_ERR_INVALID_AUTH_SPEC

SqlState = 28000

DB_ERR_INVALID_CURSOR_NAME

SqlState = 34000

DB_ERR_SYNTAX_ERROR_OR_ACCESS_VIOL

SqlState = 37000

DB_ERR_DUPLICATE_CURSOR_NAME

SqlState = 3C000

DB_ERR_SERIALIZATION_FAILURE

SqlState = 40001

DB_ERR_SYNTAX_ERROR_OR_ACCESS_VIOL2

SqlState = 42000

DB_ERR_OPERATION_ABORTED

SqlState = 70100

DB_ERR_UNSUPPORTED_FUNCTION

SqlState = IM001

DB_ERR_NO_DATA_SOURCE

SqlState = IM002

DB_ERR_DRIVER_LOAD_ERROR

SqlState = IM003

DB_ERR_SQLALLOCENV_FAILED

SqlState = IM004

DB_ERR_SQLALLOCCONNECT_FAILED

SqlState = IM005

DB_ERR_SQLSETCONNECTOPTION_FAILED

SqlState = IM006

DB_ERR_NO_DATA_SOURCE_DLG_PROHIB

SqlState = IM007

DB_ERR_DIALOG_FAILED

SqlState = IM008

DB_ERR_UNABLE_TO_LOAD_TRANSLATION_DLL

SqlState = IM009

DB_ERR_DATA_SOURCE_NAME_TOO_LONG

SqlState = IM010

DB_ERR_DRIVER_NAME_TOO_LONG

SqlState = IM011

DB_ERR_DRIVER_KEYWORD_SYNTAX_ERROR

SqlState = IM012

DB_ERR_TRACE_FILE_ERROR

SqlState = IM013

DB_ERR_TABLE_OR_VIEW_ALREADY_EXISTS

SqlState = S0001

DB_ERR_TABLE_NOT_FOUND

SqlState = S0002

DB_ERR_INDEX_ALREADY_EXISTS

SqlState = S0011

DB_ERR_INDEX_NOT_FOUND

SqlState = S0012

DB_ERR_COLUMN_ALREADY_EXISTS

SqlState = S0021

DB_ERR_COLUMN_NOT_FOUND

SqlState = S0022

DB_ERR_NO_DEFAULT_FOR_COLUMN

SqlState = S0023

DB_ERR_GENERAL_ERROR

SqlState = S1000

DB_ERR_MEMORY_ALLOCATION_FAILURE

SqlState = S1001

DB_ERR_INVALID_COLUMN_NUMBER

SqlState = S1002

DB_ERR_PROGRAM_TYPE_OUT_OF_RANGE

SqlState = S1003

DB_ERR_SQL_DATA_TYPE_OUT_OF_RANGE

SqlState = S1004

DB_ERR_OPERATION_CANCELLED

SqlState = S1008

DB_ERR_INVALID_ARGUMENT_VALUE

SqlState = S1009

DB_ERR_FUNCTION_SEQUENCE_ERROR

SqlState = S1010

DB_ERR_OPERATION_INVALID_AT_THIS_TIME

SqlState = S1011

DB_ERR_INVALID_TRANS_OPERATION_CODE

SqlState = S1012

DB_ERR_NO_CURSOR_NAME_AVAIL

SqlState = S1015

DB_ERR_INVALID_STR_OR_BUF_LEN

SqlState = S1090

DB_ERR_DESCRIPTOR_TYPE_OUT_OF_RANGE

SqlState = S1091

DB_ERR_OPTION_TYPE_OUT_OF_RANGE

SqlState = S1092

DB_ERR_INVALID_PARAM_NO

SqlState = S1093

DB_ERR_INVALID_SCALE_VALUE

SqlState = S1094

DB_ERR_FUNCTION_TYPE_OUT_OF_RANGE

SqlState = S1095

DB_ERR_INF_TYPE_OUT_OF_RANGE

SqlState = S1096

DB_ERR_COLUMN_TYPE_OUT_OF_RANGE

SqlState = S1097

DB_ERR_SCOPE_TYPE_OUT_OF_RANGE

SqlState = S1098

DB_ERR_NULLABLE_TYPE_OUT_OF_RANGE

SqlState = S1099

DB_ERR_UNIQUENESS_OPTION_TYPE_OUT_OF_RANGE

SqlState = S1100

DB_ERR_ACCURACY_OPTION_TYPE_OUT_OF_RANGE

SqlState = S1101

DB_ERR_DIRECTION_OPTION_OUT_OF_RANGE

SqlState = S1103

DB_ERR_INVALID_PRECISION_VALUE

SqlState = S1104

DB_ERR_INVALID_PARAM_TYPE

SqlState = S1105

DB_ERR_FETCH_TYPE_OUT_OF_RANGE

SqlState = S1106

DB_ERR_ROW_VALUE_OUT_OF_RANGE

SqlState = S1107

DB_ERR_CONCURRENCY_OPTION_OUT_OF_RANGE

SqlState = S1108

DB_ERR_INVALID_CURSOR_POSITION

SqlState = S1109

DB_ERR_INVALID_DRIVER_COMPLETION

SqlState = S1110

DB_ERR_INVALID_BOOKMARK_VALUE

SqlState = S1111

DB_ERR_DRIVER_NOT_CAPABLE

SqlState = S1C00

DB_ERR_TIMEOUT_EXPIRED

SqlState = S1T00

DB_ERR_FETCH_NULL

Unexpected NULL value

DB_ERR_INVALID_TABLE_NAME

Invalid (or unknown) table name

DB_ERR_INVALID_COLUMN_NAME

Invalid (or unknown) column name

DB_ERR_TYPE_MISMATCH

Trying to convert a SQL value of the wrong type

DB_ERR_CONNECT

Unable to establish a connection

Sql types

data DbType Source

Standard logical database types.

Constructors

DbUnknown 
DbVarChar

Strings

DbInteger 
DbFloat 
DbDate 
DbBlob

Binary

data SqlType Source

Standard SQL types.

Constructors

SqlChar

Fixed Strings

SqlNumeric 
SqlDecimal 
SqlInteger 
SqlSmallInt 
SqlFloat 
SqlReal 
SqlDouble 
SqlDate 
SqlTime 
SqlTimeStamp 
SqlVarChar

Strings

SqlBit 
SqlBinary 
SqlVarBinary 
SqlBigInt 
SqlTinyInt 
SqlUnknown Int

Unknown SQL type. Argument specifies the system sql type.

toSqlTableName :: Db a -> TableName -> TableNameSource

Convert a table name to a format that can be used directly in SQL statements. For example, this call can do case conversion and quoting.

toSqlColumnName :: Db a -> ColumnName -> ColumnNameSource

Convert a column name to a format that can be used directly in SQL statements. For example, this call can do case conversion and quoting.

toSqlString :: String -> StringSource

Convert a string to SQL string

toSqlTime :: ClockTime -> StringSource

Convert a ClockTime to a SQL time string (without year/month/day).

toSqlDate :: ClockTime -> StringSource

Convert a ClockTime to a SQL date string (without hours/minutes/seconds).

toSqlTimeStamp :: ClockTime -> StringSource

Convert a ClockTime to a SQL full date (timestamp) string.

Internal

dbStringRead :: Db a -> ColumnInfo -> IO (Maybe String)Source

Low level string reading.

dbGetDataNull :: Db a -> (Ptr CInt -> IO Bool) -> IO BoolSource

Internal: used to implement dbReadValue methods. Takes a dbGetData... method and supplies the Ptr CInt argument. It raises and exception on error. Otherwise, it returns True when a NULL value is read.

toSqlType :: Int -> SqlTypeSource

Convert a system SQL type (like wxSQL_C_CHAR) to a standard SqlType.

fromSqlType :: SqlType -> IntSource

Convert to a system SQL type (like wxSQL_C_INTEGER) from a standard SqlType.