--------------------------------------------------------------------------------
{-|	Module      :  Db
	Copyright   :  (c) Daan Leijen 2003
	License     :  wxWindows

	Maintainer  :  wxhaskell-devel@lists.sourceforge.net
	Stability   :  provisional
	Portability :  portable
  
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'.
-}
--------------------------------------------------------------------------------
module Graphics.UI.WXCore.Db
   ( 
   -- * Connection
      dbWithConnection, dbConnect, dbDisconnect
   , dbWithDirectConnection, dbConnectDirect
   -- * Queries
   , dbQuery, dbQuery_
   
   -- * Changes
   , dbExecute, dbTransaction

   -- * Rows
   , DbRow(..)

   -- ** Standard values
   , dbRowGetString, dbRowGetStringMb
   , dbRowGetBool, dbRowGetBoolMb
   , dbRowGetInt, dbRowGetIntMb
   , dbRowGetDouble, dbRowGetDoubleMb
   , dbRowGetInteger, dbRowGetIntegerMb
   , dbRowGetClockTime, dbRowGetClockTimeMb

   -- ** Generic values
   , DbValue( dbValueRead, toSqlValue )
   , dbRowGetValue, dbRowGetValueMb
   
   -- ** Column information
   , dbRowGetColumnInfo, dbRowGetColumnInfos
     
   -- * Meta information
   -- ** Data sources
   , DataSourceName, dbGetDataSources
   , dbGetDataSourceInfo, dbGetDataSourceTableInfo
   
   -- ** Tables and columns
   , TableName, ColumnName, ColumnIndex
   , DbInfo(..), TableInfo(..), ColumnInfo(..)
   , dbGetInfo, dbGetTableInfo, dbGetTableColumnInfos, dbGetColumnInfos

   -- ** Dbms
   , Dbms(..), dbGetDbms   

   -- * Exceptions
   , DbError(..)
   , catchDbError, raiseDbError
   , dbHandleExn, dbCheckExn, dbRaiseExn
   , dbGetErrorMessages
   , dbGetDbStatus, DbStatus(..)
   
   -- * Sql types
   , DbType(..), SqlType(..)
   , toSqlTableName, toSqlColumnName
   , toSqlString, toSqlTime, toSqlDate, toSqlTimeStamp

   -- * Internal
   , dbStringRead, dbGetDataNull, toSqlType, fromSqlType
   ) where


import Graphics.UI.WXCore.WxcTypes
import Graphics.UI.WXCore.WxcDefs
import Graphics.UI.WXCore.WxcClasses
import Graphics.UI.WXCore.Types

import System.IO.Error( catch, ioError, isUserError, ioeGetErrorString)
import Data.List( isPrefixOf )
import Data.Char( isDigit )
import Foreign
import Foreign.Ptr
import Foreign.C.String
import Foreign.Marshal.Array
import System.Time


withValidObject :: (Object a -> IO ()) -> Object a -> IO ()
withValidObject f p
  = if (objectIsNull p) then return () else f p
{----------------------------------------------------------
  Query
----------------------------------------------------------}
-- | 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 [b]
dbQuery db select action
  = do dbExecute db select
       infos <- dbGetColumnInfos db
       walkRows (DbRow db infos) [] 
  where
    walkRows row acc
      = do ok <- dbGetNext db
           if (not ok)
            then return (reverse acc)
            else do x <- action row
                    walkRows row (x:acc)

-- | 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)
--
dbQuery_ :: Db a -> String -> (DbRow a -> IO b) -> IO ()
dbQuery_ db select action
  = do dbHandleExn db $ dbExecSql db select
       infos <- dbGetColumnInfos db
       walkRows (DbRow db infos) 
  where
    walkRows row 
      = do ok <- dbGetNext db
           if (not ok)
            then return ()
            else do action row
                    walkRows row 

-- | Execute a SQL statement against the database. Raises a 'DbError'
-- on failure.
dbExecute :: Db a -> String -> IO ()
dbExecute db sql
  = dbHandleExn db $ dbExecSql db sql


-- | 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)"
--       
dbTransaction :: Db a -> IO b -> IO b
dbTransaction db io
  = do x <- io
       dbHandleExn db (dbCommitTrans db)
       return x

{----------------------------------------------------------
  Result rows of a query
----------------------------------------------------------}
-- | An abstract database row.
data DbRow a = DbRow (Db a) [ColumnInfo]

-- | Get the column information of a row.
dbRowGetColumnInfos :: DbRow a -> [ColumnInfo]
dbRowGetColumnInfos (DbRow db columnInfos)
  = columnInfos

-- | The column information of a particular column. 
-- Raises a 'DbError' on failure.
dbRowGetColumnInfo :: DbRow a -> ColumnName -> IO ColumnInfo
dbRowGetColumnInfo (DbRow db columnInfos) name
  = case lookup name (zip (map columnName columnInfos) columnInfos) of
      Just info -> return info
      Nothing   -> if (all isDigit name)
                    then case lookup (read name) (zip (map columnIndex columnInfos) columnInfos) of
                           Just info -> return info
                           Nothing   -> err
                    else err
  where
    err = raiseDbInvalidColumnName db (name ++ " in " ++ (show (map columnName columnInfos)))

-- | Get a database value ('DbValue') from a row.
-- Returns 'Nothing' when a @NULL@ value is encountered.
-- Raises a 'DbError' on failure.
dbRowGetValueMb   :: DbValue b => DbRow a -> ColumnName -> IO (Maybe b)
dbRowGetValueMb row@(DbRow db columnInfos) name
  = do info <- dbRowGetColumnInfo row name
       dbValueRead db info 

-- | Get a database value ('DbValue') from a row. 
-- Raises a 'DbError' on failure or when a @NULL@ value is encountered.
dbRowGetValue :: DbValue b => DbRow a -> ColumnName -> IO b
dbRowGetValue row@(DbRow db columnInfos) columnName
  = do mbValue <- dbRowGetValueMb row columnName
       case mbValue of
         Just x  -> return x
         Nothing -> raiseDbFetchNull db

-- | Class of values that are supported by the database.
class DbValue a where
  -- | 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).
  dbValueRead :: Db b -> ColumnInfo -> IO (Maybe a)

  -- | Convert a value to a string representation that can be
  -- used directly in a SQL statement.
  toSqlValue  :: a -> String

instance DbValue Bool where
  dbValueRead db columnInfo 
    = alloca $ \pint ->
      do isNull <- dbGetDataNull db $ dbGetDataInt db (columnIndex columnInfo) pint
         if isNull 
          then return Nothing
          else do i <- peek pint
                  return (Just (i/=0))
  toSqlValue b
    = if b then "TRUE" else "FALSE"

instance DbValue Int where
  dbValueRead db columnInfo 
    = alloca $ \pint ->
      do isNull <- dbGetDataNull db $ dbGetDataInt db (columnIndex columnInfo) pint
         if isNull 
          then return Nothing
          else do i <- peek pint
                  return (Just (fromCInt i))
  toSqlValue i
    = show i

instance DbValue Double where
  dbValueRead db columnInfo 
    = alloca $ \pdouble ->
      do isNull <- dbGetDataNull db $ dbGetDataDouble db (columnIndex columnInfo) pdouble
         if isNull 
          then return Nothing
          else do d <- peek pdouble
                  return (Just d)

  toSqlValue d
    = show d

instance DbValue Integer where
  dbValueRead db columnInfo 
    = do mbS <- dbStringRead db columnInfo 
         case mbS of
           Nothing -> return Nothing
           Just s  -> case parse s of
                        Just i  -> return (Just i)
                        Nothing -> raiseDbTypeMismatch db 
    where
      parse s
        = let (val,xs) = span isDigit s
          in case xs of
               ('.':frac) | all isDigit frac 
                          -> Just (read (val ++ adjust (columnDecimalDigits columnInfo) frac))
               other      -> Nothing

  toSqlValue i
    = show i


instance DbValue ClockTime where
  dbValueRead db columnInfo
    = alloca $ \pfraction ->
      alloca $ \psecs ->
      do poke pfraction (toCInt 0)
         isNull <- dbGetDataNull db $
                   case columnSqlType columnInfo of
                     SqlDate -> dbGetDataDate db (columnIndex columnInfo) psecs
                     SqlTime -> dbGetDataTime db (columnIndex columnInfo) psecs
                     other   -> dbGetDataTimeStamp db (columnIndex columnInfo) psecs pfraction
         if (isNull)
          then return Nothing
          else do secs     <- peek psecs
                  fraction <- peek pfraction
                  return (Just (TOD (fromIntegral secs) (fromIntegral fraction * 1000)))

  toSqlValue ctime
    = toSqlTimeStamp ctime


-- | Read an 'Bool' from the database. 
-- Raises a 'DbError' on failure or when a @NULL@ value is encountered.
dbRowGetBool :: DbRow a -> ColumnName -> IO Bool
dbRowGetBool = dbRowGetValue

-- | Read an 'Bool' from the database. 
-- Returns 'Nothing' when a @NULL@ value is encountered.
-- Raises a 'DbError' on failure.
dbRowGetBoolMb :: DbRow a -> ColumnName -> IO (Maybe Bool)
dbRowGetBoolMb = dbRowGetValueMb


-- | Read an 'Int' from the database. 
-- Raises a 'DbError' on failure or when a @NULL@ value is encountered.
dbRowGetInt :: DbRow a -> ColumnName -> IO Int
dbRowGetInt = dbRowGetValue

-- | Read an 'Int' from the database. 
-- Returns 'Nothing' when a @NULL@ value is encountered.
-- Raises a 'DbError' on failure.
dbRowGetIntMb :: DbRow a -> ColumnName -> IO (Maybe Int)
dbRowGetIntMb = dbRowGetValueMb


-- | Read an 'Double' from the database. 
-- Raises a 'DbError' on failure or when a @NULL@ value is encountered.
dbRowGetDouble :: DbRow a -> ColumnName -> IO Double
dbRowGetDouble = dbRowGetValue

-- | Read an 'Double' from the database. 
-- Returns 'Nothing' when a @NULL@ value is encountered.
-- Raises a 'DbError' on failure.
dbRowGetDoubleMb :: DbRow a -> ColumnName -> IO (Maybe Double)
dbRowGetDoubleMb = dbRowGetValueMb


-- | Read an 'Integer' from the database. 
-- Raises a 'DbError' on failure or when a @NULL@ value is encountered.
dbRowGetInteger :: DbRow a -> ColumnName -> IO Integer
dbRowGetInteger = dbRowGetValue

-- | Read an 'Integer' from the database. 
-- Returns 'Nothing' when a @NULL@ value is encountered.
-- Raises a 'DbError' on failure.
dbRowGetIntegerMb :: DbRow a -> ColumnName -> IO (Maybe Integer)
dbRowGetIntegerMb = dbRowGetValueMb

-- | 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.
dbRowGetClockTime :: DbRow a -> ColumnName -> IO ClockTime
dbRowGetClockTime = dbRowGetValue

-- | 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.
dbRowGetClockTimeMb :: DbRow a -> ColumnName -> IO (Maybe ClockTime)
dbRowGetClockTimeMb = dbRowGetValueMb


-- | Read a string value from the database. Returns the empty
-- string when a @NULL@ value is encountered.
-- Raises a 'DbError' on failure.
dbRowGetString :: DbRow a -> ColumnName -> IO String
dbRowGetString row name
  = do mbStr <- dbRowGetStringMb row name
       return (maybe "" id mbStr)

-- | Read a string from the database. Returns 'Nothing' when a
-- @NULL@ value is encountered.
-- Raises a 'DbError' on failure.
dbRowGetStringMb :: DbRow a -> ColumnName -> IO (Maybe String)
dbRowGetStringMb row@(DbRow db columnInfos) name
  = do info <- dbRowGetColumnInfo row name
       dbStringRead db info 

-- | Low level string reading.
dbStringRead :: Db a -> ColumnInfo -> IO (Maybe String)
dbStringRead db info 
  = alloca $ \pbuf ->
    alloca $ \plen ->
    do dbHandleExn db $ dbGetDataBinary db (columnIndex info) True pbuf plen
       len <- peek plen
       if (fromCInt len == wxSQL_NULL_DATA)
        then do buf <- peek pbuf
                wxcFree buf
                return Nothing
        else do buf <- peek pbuf
                s   <- peekCStringLen (buf,fromCInt len)
                wxcFree buf
                return (Just s)

-- | Convert a string to SQL string
toSqlString :: String -> String
toSqlString s
  = "'" ++ concatMap quote s ++ "'"
  where
    quote '\''  = "''"
    quote c     = [c]

-- | Convert a 'ClockTime' to a SQL date string (without hours\/minutes\/seconds).
toSqlDate :: ClockTime -> String    
toSqlDate ctime
    = "'" ++ show (ctYear t) ++ "-" ++ show (ctMonth t) ++ "-" ++ show (ctDay t) ++ "'"
    where
      t = toUTCTime ctime

-- | Convert a 'ClockTime' to a SQL full date (timestamp) string.
toSqlTimeStamp :: ClockTime -> String    
toSqlTimeStamp ctime
    = "'" ++ show (ctYear t) ++ "-" ++ show (ctMonth t) ++ "-" ++ show (ctDay t)
      ++ " " ++ show (ctHour t) ++ ":" ++ show (ctMin t) ++ ":" ++ show (ctSec t) ++ "'"
    where
      t = toUTCTime ctime

-- | Convert a 'ClockTime' to a SQL time string (without year\/month\/day).
toSqlTime :: ClockTime -> String    
toSqlTime ctime
    = "'" ++ show (ctHour t) ++ ":" ++ show (ctMin t) ++ ":" ++ show (ctSec t) ++ "'"
    where
      t = toUTCTime ctime


-- | 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.
dbGetDataNull :: Db a -> (Ptr CInt -> IO Bool) -> IO Bool
dbGetDataNull db getData
  = alloca $ \pused ->
    do dbHandleExn db $ getData pused
       used <- peek pused
       return (fromCInt used == wxSQL_NULL_DATA)
    
{----------------------------------------------------------
  Open connection
----------------------------------------------------------}
{- | 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.
-}
dbWithConnection :: DataSourceName -> String -> String -> (Db () -> IO b) -> IO b
dbWithConnection name userid password f
  = bracket (dbConnect name userid password)
            (dbDisconnect)
            (f)


{- | 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.
-}
dbWithDirectConnection :: DataSourceName -> String -> String -> (Db () -> IO b) -> IO b
dbWithDirectConnection name userid password f
  = bracket (dbConnectDirect name userid password)
            (\db -> do{ dbClose db; dbDelete db } )
            (f)


-- | (@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.
dbConnect :: DataSourceName -> String -> String -> IO (Db ())
dbConnect name userId password
  = bracket (dbConnectInfCreate nullHENV name userId password "" "" "" )
            (dbConnectInfDelete)
            (\connectInf -> 
              do db <- dbGetConnection connectInf True
                 if objectIsNull db 
                  then dbConnectDirect name userId password
                  else do opened <- dbIsOpen db
                          if (not opened)
                           then do dbFreeConnection db
                                   dbConnectDirect name userId password
                           else return db)

-- | 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.
dbConnectDirect :: DataSourceName -> String -> String -> IO (Db ())
dbConnectDirect dataSource userId password 
  = bracket (dbConnectInfCreate nullHENV dataSource userId password "" "" "") 
            (dbConnectInfDelete)
            (\connectInf ->
             do henv <- dbConnectInfGetHenv connectInf
                db   <- dbCreate henv True
                if (objectIsNull db)
                 then raiseDbConnect dataSource
                 else do opened <- dbOpen db dataSource userId password
                         if (not opened)
                          then finalize (dbDelete db)
                                        (dbRaiseExn db)
                          else return db)


-- | Closes a connection opened with 'dbConnect' (or 'dbConnectDirect').
dbDisconnect :: Db a -> IO ()
dbDisconnect db
  = do freed <- dbFreeConnection db
       if (freed) 
        then return ()
        else do dbClose db
                dbDelete db


{----------------------------------------------------------
  Database meta information
----------------------------------------------------------}
type DataSourceName = String
type TableName      = String

-- | 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\"@.
type ColumnName     = String
type ColumnIndex    = Int

-- | Database information.
data DbInfo
  = DbInfo   { dbCatalog  :: String       -- ^ System name of the database
             , dbSchema   :: String       -- ^ Schema name
             , dbTables   :: [TableInfo]  -- ^ The tables of the database
             }

-- | Database table information.
data TableInfo
  = TableInfo{ 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.
             }

-- | Database column information.
data ColumnInfo
  = ColumnInfo{ 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.
              }


-- | 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 
-- 
dbGetDataSourceInfo :: DataSourceName -> String -> String -> IO DbInfo
dbGetDataSourceInfo dataSource userId password
  = dbWithConnection dataSource userId password dbGetInfo

-- | 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.
dbGetDataSourceTableInfo :: DataSourceName -> TableName -> String -> String -> IO TableInfo
dbGetDataSourceTableInfo dataSource tableName userId password
  = dbWithConnection dataSource userId password (\db -> dbGetTableInfo db tableName)

-- | Get the meta information of a table in a database.
dbGetTableInfo :: Db a -> TableName -> IO TableInfo
dbGetTableInfo db name
  = do info <- dbGetInfo db
       case lookup name (zip (map tableName (dbTables info)) (dbTables info)) of
         Nothing    -> raiseDbInvalidTableName db name
         Just tinfo -> return tinfo

-- | Get the complete meta information of a database.
dbGetInfo :: Db a -> IO DbInfo
dbGetInfo db
  = bracket (dbGetCatalog db "")
            (withValidObject dbInfDelete)
            (\dbInf ->do catalog  <- dbInfGetCatalogName dbInf
                         schema   <- dbInfGetSchemaName  dbInf
                         numTables<- dbInfGetNumTables   dbInf
                         tables   <- mapM (\idx -> do tableInf <- dbInfGetTableInf dbInf (idx-1)
                                                      dbTableInfGetInfo tableInf db) 
                                          [1..numTables]
                         return (DbInfo catalog schema tables))

dbTableInfGetInfo :: DbTableInf a -> Db b -> IO TableInfo
dbTableInfGetInfo tableInf db
  = do tableName <- dbTableInfGetTableName tableInf
       tableType <- dbTableInfGetTableType tableInf
       remarks   <- dbTableInfGetTableRemarks tableInf
       numCols   <- dbTableInfGetNumCols tableInf
       columns   <- dbGetTableColumnInfos db tableName  
       return (TableInfo tableName tableType remarks columns)

-- | Return the column information of the current query.
dbGetColumnInfos :: Db a -> IO [ColumnInfo]
dbGetColumnInfos db
  = alloca $ \pcnumCols ->
    bracket (dbGetResultColumns db pcnumCols)
            (withValidObject dbColInfArrayDelete)
            (\colInfs  -> do cnumCols <- peek pcnumCols
                             let numCols = fromCInt cnumCols
                             mapM (\idx -> do colInf <- dbColInfArrayGetColInf colInfs (idx-1)
                                              dbColInfGetInfo colInf idx) 
                                  [1..numCols])
    

-- | Return the column information of a certain table. Use an empty
-- table name to get the column information of the current query
-- ('dbGetColumnInfos').
dbGetTableColumnInfos :: Db a -> TableName -> IO [ColumnInfo]
dbGetTableColumnInfos db tableName
  | null tableName = dbGetColumnInfos db
  | otherwise =
    alloca $ \pcnumCols ->
    bracket (dbGetColumns db tableName pcnumCols "")
            (withValidObject dbColInfArrayDelete)
            (\colInfs  -> do cnumCols <- peek pcnumCols
                             let numCols = fromCInt cnumCols
                             mapM (\idx -> do colInf <- dbColInfArrayGetColInf colInfs (idx-1)
                                              dbColInfGetInfo colInf idx) 
                                  [1..numCols])
        
             
dbColInfGetInfo :: DbColInf a -> ColumnIndex -> IO ColumnInfo
dbColInfGetInfo info idx
  = do columnName <- dbColInfGetColName info
       columnSize <- dbColInfGetColumnSize info
       nullable   <- dbColInfIsNullable info
       tp         <- dbColInfGetDbDataType info
       sqltp      <- dbColInfGetSqlDataType info
       tpname     <- dbColInfGetTypeName info
       remarks    <- dbColInfGetRemarks info
       decdigits  <- dbColInfGetDecimalDigits info
       numprecrad <- dbColInfGetNumPrecRadix info
       fk         <- dbColInfGetFkCol info
       fkname     <- dbColInfGetFkTableName info
       pk         <- dbColInfGetPkCol info
       pkname     <- dbColInfGetPkTableName info
       return (ColumnInfo columnName idx columnSize nullable (toEnum tp) (toSqlType sqltp) tpname remarks
                          decdigits numprecrad fk pk fkname (parseTables pkname) )
  where
    -- tables formatted as: "[name1][name2]...". Parser basically admits anything :-)
    parseTables []        = []  -- done
    parseTables ('[':xs)  = let (name,ys) = span (/=']') xs  -- take till close bracket
                            in name : parseTables ys
    parseTables (']':xs)  = parseTables xs    -- ignore ']'
    parseTables (' ':xs)  = parseTables xs    -- ignore ' '
    parseTables xs        = [xs]              -- should not happen: take rest as a single database name


{----------------------------------------------------------
  Data sources
----------------------------------------------------------}
-- | Returns the name and description of the data sources on the system.
dbGetDataSources :: IO [(DataSourceName,String)]
dbGetDataSources 
  = do connectInf <- dbConnectInfCreate nullHENV "" "" "" "" "" ""
       henv       <- dbConnectInfGetHenv connectInf
       xs         <- loop henv True
       dbConnectInfDelete connectInf
       return xs
  where
    loop henv isFirst
      = do mbSrc <- dbGetDataSourceEx henv isFirst
           case mbSrc of
             Nothing  -> return []
             Just x   -> do xs <- loop henv False
                            return (x:xs)

dbGetDataSourceEx :: HENV () -> Bool -> IO (Maybe (String,String))
dbGetDataSourceEx henv isFirst
  = allocaArray (dsnLen+1)  $ \cdsn  ->
    allocaArray (descLen+1) $ \cdesc ->
    do pokeArray0 0 cdsn []
       pokeArray0 0 cdesc []
       ok   <- dbGetDataSource henv (castPtr cdsn) dsnLen (castPtr cdesc) descLen 
                               (if isFirst then wxSQL_FETCH_FIRST else wxSQL_FETCH_NEXT)
       if not ok
        then return Nothing
        else do dsn  <- peekCWString cdsn
                desc <- peekCWString cdesc 
                return (Just (dsn,desc))
  where
    dsnLen  = 255
    descLen = 1024


-- | Get the data source name of a database.
dbGetDataSourceName :: Db a -> IO DataSourceName
dbGetDataSourceName db
  = dbGetDatasourceName db

{----------------------------------------------------------
  Dbms
----------------------------------------------------------}
-- The Database backend system.
data Dbms
  = DbmsORACLE 
  | DbmsSYBASE_ASA         -- ^ Adaptive Server Anywhere
  | DbmsSYBASE_ASE         -- ^ Adaptive Server Enterprise
  | DbmsMS_SQL_SERVER 
  | DbmsMY_SQL 
  | DbmsPOSTGRES 
  | DbmsACCESS 
  | DbmsDBASE 
  | DbmsINFORMIX 
  | DbmsVIRTUOSO 
  | DbmsDB2 
  | DbmsINTERBASE 
  | DbmsPERVASIVE_SQL 
  | DbmsXBASE_SEQUITER 
  | DbmsUNIDENTIFIED 
  deriving (Eq,Enum,Show)

-- | Retrieve the database backend system.
dbGetDbms :: Db a -> IO Dbms
dbGetDbms db
  = do i <- dbDbms db
       if (i==0 || i > fromEnum DbmsUNIDENTIFIED)
        then return DbmsUNIDENTIFIED
        else return (toEnum (i-1))
       

{----------------------------------------------------------
  Database Exceptions
----------------------------------------------------------}
-- | Database error type.
data DbError
  = DbError   { dbErrorMsg   :: String
              , dbDataSource :: DataSourceName
              , dbErrorCode  :: DbStatus 
              , dbNativeCode :: Int
              , dbSqlState   :: String  
              }    -- ^ General error.
  deriving (Read,Show)  


-- | 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"           
--
dbHandleExn :: Db a -> IO Bool -> IO ()
dbHandleExn db io
  = do ok <- io
       if ok
        then return ()
        else dbRaiseExn db

-- | Raise a database exception based on the current error status of
-- the database. Does nothing when no error is set.
dbCheckExn :: Db a -> IO ()
dbCheckExn db
  = do status <- dbGetDbStatus db
       if (status == DB_SUCCESS)
        then return ()
        else dbRaiseExn db

-- | Raise a database exception based on the current error status of
-- the database.
dbRaiseExn :: Db a -> IO b
dbRaiseExn db
  = do errorMsg  <- dbGetErrorMessage db 0
       errorCode <- dbGetDbStatus db
       nativeCode<- dbGetNativeError db
       dataSource<- dbGetDataSourceName db
       raiseDbError (DbError (extractMessage errorMsg) dataSource errorCode nativeCode (extractSqlState errorMsg))
  where
    extractSqlState msg
      | isPrefixOf sqlStatePrefix msg = takeWhile (/='\n') (drop (length sqlStatePrefix) msg)
      | otherwise                     = ""
      where
        sqlStatePrefix  = "SQL State = "

    extractMessage msg
      = dropTillPrefix "Error Message = " msg

    dropTillPrefix prefix msg
      = walk msg
      where
        walk s  | null s                = msg
                | isPrefixOf prefix s   = drop (length prefix) s
                | otherwise             = walk (tail s)

-- | Get the raw error message history. More recent error messages
-- come first.
dbGetErrorMessages :: Db a -> IO [String]
dbGetErrorMessages db
  = do n <- dbGetNumErrorMessages db
       mapM (\idx -> dbGetErrorMessage db (idx-1)) [1..n]

-- | Raise a type mismatch error
raiseDbTypeMismatch :: Db a -> IO b
raiseDbTypeMismatch db
  = do dataSource <- dbGetDataSourceName db
       raiseDbError (DbError "Type mismatch" dataSource DB_ERR_TYPE_MISMATCH 0 "" )

-- | Raise a fetch null error
raiseDbFetchNull :: Db a -> IO b
raiseDbFetchNull db
  = do dataSource <- dbGetDataSourceName db
       raiseDbError (DbError "Unexpected NULL value" dataSource DB_ERR_FETCH_NULL 0 "")

-- | Raise an invalid column name error
raiseDbInvalidColumnName :: Db a -> ColumnName -> IO b
raiseDbInvalidColumnName db name
  = do dataSource <- dbGetDataSourceName db
       raiseDbError (DbError ("Invalid column name/index (" ++ name ++ ")") dataSource DB_ERR_INVALID_COLUMN_NAME 0 "")

-- | Raise an invalid table name error
raiseDbInvalidTableName :: Db a -> ColumnName -> IO b
raiseDbInvalidTableName db name
  = do dataSource <- dbGetDataSourceName db
       raiseDbError (DbError ("Invalid table name (" ++ name ++ ")") dataSource DB_ERR_INVALID_TABLE_NAME 0 "")

-- | Raise a connection error
raiseDbConnect :: DataSourceName -> IO a
raiseDbConnect name
  = raiseDbError (DbError ("Unable to establish a connection to the '" ++ name ++ "' database") 
                 name DB_ERR_CONNECT 0 "")

-- | Raise a database error.
raiseDbError :: DbError -> IO a
raiseDbError err
  = ioError (userError (dbErrorPrefix ++ show err))

-- | Handle database errors.
catchDbError :: IO a -> (DbError -> IO a) -> IO a
catchDbError io handler
  = catch io $ \err -> 
    let errmsg = ioeGetErrorString err
    in if (isUserError err && isPrefixOf dbErrorPrefix errmsg)
        then handler (read (drop (length dbErrorPrefix) errmsg))
        else ioError err
     
dbErrorPrefix
  = "Database error: "

{----------------------------------------------------------
  Database Status
----------------------------------------------------------}
-- | Status of the database.
data DbStatus
  = 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
  deriving (Read,Show,Eq,Enum)

-- | Retrieve the current status of the database
dbGetDbStatus :: Db a -> IO DbStatus
dbGetDbStatus db
  = do i <- dbGetStatus db
       if (i < 0 || i >= fromEnum DB_ERR_CONNECT)
        then return DB_FAILURE
        else return (toEnum i)

{----------------------------------------------------------
  Db types
----------------------------------------------------------}
-- | Standard logical database types.
data DbType
  = DbUnknown 
  | DbVarChar         -- ^ Strings
  | DbInteger         
  | DbFloat       
  | DbDate
  | DbBlob            -- ^ Binary
  deriving (Show,Eq,Enum)

-- | Standard SQL types. 
data SqlType
  = 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.
  deriving (Show,Eq)

instance Enum SqlType where
  toEnum i
    = case i of
        1  -> SqlChar           
        2  -> SqlNumeric
        3  -> SqlDecimal
        4  -> SqlInteger
        5  -> SqlSmallInt
        6  -> SqlFloat
        7  -> SqlReal
        8  -> SqlDouble
        9  -> SqlDate
        10 -> SqlTime
        11 -> SqlTimeStamp
        12 -> SqlVarChar
        13 -> SqlBit
        14 -> SqlBinary
        15 -> SqlVarBinary
        16 -> SqlBigInt
        17 -> SqlTinyInt
        _  -> SqlUnknown i

  fromEnum tp
    = case tp of
        SqlChar       -> 1
        SqlNumeric    -> 2
        SqlDecimal    -> 3
        SqlInteger    -> 4
        SqlSmallInt   -> 5
        SqlFloat      -> 6
        SqlReal       -> 7
        SqlDouble     -> 8
        SqlDate       -> 9
        SqlTime       -> 10 
        SqlTimeStamp  -> 11
        SqlVarChar    -> 12
        SqlBit        -> 13
        SqlBinary     -> 14
        SqlVarBinary  -> 15
        SqlBigInt     -> 16
        SqlTinyInt    -> 17 
        SqlUnknown i  -> i

-- | Convert a system SQL type (like 'wxSQL_C_CHAR') to a standard 'SqlType'.
toSqlType :: Int -> SqlType
toSqlType i
  = unsafePerformIO $
    do tp <- dbSqlTypeToStandardSqlType i
       return (toEnum tp)

-- | Convert to a system SQL type (like 'wxSQL_C_INTEGER') from a standard 'SqlType'.
fromSqlType :: SqlType -> Int
fromSqlType tp
  = unsafePerformIO (dbStandardSqlTypeToSqlType (fromEnum tp))

-- | 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.
toSqlTableName :: Db a -> TableName -> TableName
toSqlTableName db name
  = unsafePerformIO $ dbSQLTableName db name

-- | 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.
toSqlColumnName :: Db a -> ColumnName -> ColumnName
toSqlColumnName db name
  = unsafePerformIO $ dbSQLColumnName db name


{----------------------------------------------------------
   Print meta information about  a particular data source
----------------------------------------------------------}
instance Show DbInfo where
  show info   = unlines (showDbInfo info)

showDbInfo :: DbInfo -> [String]
showDbInfo info
  = ["catalog: " ++ dbCatalog info
    ,"schema : " ++ dbSchema info
    ,"tables : "
    ] ++ 
    numbered (map showTableInfo (dbTables info))


instance Show TableInfo where
  show info   = unlines (showTableInfo info)

showTableInfo :: TableInfo -> [String]
showTableInfo info
  = ["name   : " ++ tableName info
    ,"type   : " ++ tableType info
    ,"remarks: " ++ tableRemarks info
    ,"columns: "
    ] ++ showColumnInfos (tableColumns info)
    

instance Show ColumnInfo where
  show info       = unlines (showColumnInfo info)
  showList infos  = showString (unlines (showColumnInfos infos))

showColumnInfos infos
  = numbered (map showColumnInfo infos)

showColumnInfo info
  = ["name   : " ++ columnName info
    ,"index  : " ++ show (columnIndex info)
    ,"type   : " ++ columnTypeName info
    ,"size   : " ++ show (columnSize info)
    ,"sqltp  : " ++ show (columnSqlType info)
    ,"type id: " ++ show (columnType info)
    ,"digits : " ++ show (columnDecimalDigits info)
    ,"prec   : " ++ show (columnNumPrecRadix info)
    ,"remarks: " ++ columnRemarks info
    ,"pkey   : " ++ show (columnPrimaryKey info)
    ,"ptables: " ++ show (columnPrimaryKeyTableNames info)
    ,"fkey   : " ++ show (columnForeignKey info)
    ,"ftable : " ++ columnForeignKeyTableName info
    ]



numbered xss
  = concat [shift (" " ++ adjust 3 (show i ++ ":")) xs | (i,xs) <- zip [1..] xss]
  where
    shift prefix []
      = []
    shift prefix (x:xs)
      = [prefix ++ x] ++ map (replicate (length prefix) ' ' ++) xs

adjust :: Int -> String -> String
adjust n s  | length s < n  = s ++ replicate (n - length s) ' '
            | otherwise     = s