{-# LINE 1 "Database/HDBC/ODBC/Connection.hsc" #-}
-- -*- mode: haskell; -*-
{-# LINE 2 "Database/HDBC/ODBC/Connection.hsc" #-}
{-# CFILES hdbc-odbc-helper.c #-}
-- Above line for hugs

module Database.HDBC.ODBC.Connection (connectODBC, Impl.Connection) where

import Database.HDBC.Types
import Database.HDBC
import Database.HDBC.DriverUtils
import qualified Database.HDBC.ODBC.ConnectionImpl as Impl
import Database.HDBC.ODBC.Api.Imports
import Database.HDBC.ODBC.Api.Errors
import Database.HDBC.ODBC.Api.Types
import Database.HDBC.ODBC.Statement
import Database.HDBC.ODBC.Wrappers
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal hiding (void)
import Foreign.Storable
import Database.HDBC.ODBC.Utils
import Foreign.ForeignPtr
import Foreign.Ptr
import Data.Word
import Data.Int
import Control.Concurrent.MVar
import Control.Monad (when, void)
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BUTF8


{-# LINE 33 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 34 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 35 "Database/HDBC/ODBC/Connection.hsc" #-}


{-# LINE 39 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 40 "Database/HDBC/ODBC/Connection.hsc" #-}

{-# LINE 41 "Database/HDBC/ODBC/Connection.hsc" #-}

{- | Connect to an ODBC server.

For information on the meaning of the passed string, please see:

<http://msdn2.microsoft.com/en-us/library/ms715433(VS.85).aspx>

An example string is:

>"DSN=hdbctest1"

This, and all other functions that use ODBC directly or indirectly, can raise
SqlErrors just like other HDBC backends.  The seErrorMsg field is specified
as a String in HDBC.  ODBC specifies this data as a list of strings.
Therefore, this driver uses show on the data from ODBC.  For friendly display,
or handling of individual component messages in your code, you can use
read on the seErrorMsg field in a context that expects @[String]@.

Important note for MySQL users:

Unless you are going to use InnoDB tables, you are strongly encouraged to set

>Option = 262144

in your odbc.ini (for Unix users), or to disable transaction support in your
DSN setup for Windows users.

If you fail to do this, the MySQL ODBC driver will incorrectly state that it
supports transactions.  dbTransactionSupport will incorrectly return True.
commit and rollback will then silently fail.  This is certainly /NOT/ what you
want.  It is a bug (or misfeature) in the MySQL driver, not in HDBC.

You should ignore this advice if you are using InnoDB tables.

-}
connectODBC :: String -> IO Impl.Connection
connectODBC args =
  B.useAsCStringLen (BUTF8.fromString args) $ \(cs, cslen) -> do
  -- Create the Environment Handle
  env <- sqlAllocEnv
  withEnvOrDie env $ \hEnv ->
    sqlSetEnvAttr hEnv 200 (getSqlOvOdbc3) 0
{-# LINE 83 "Database/HDBC/ODBC/Connection.hsc" #-}

  -- Create the DBC handle.
  dbc <- sqlAllocDbc env
  -- Now connect.
  withDbcOrDie dbc $ \hDbc ->
    sqlDriverConnect hDbc nullPtr cs (fromIntegral cslen)
                     nullPtr 0 nullPtr 0
{-# LINE 90 "Database/HDBC/ODBC/Connection.hsc" #-}
    >>= checkError "connectODBC/sqlDriverConnect" (DbcHandle hDbc)

  mkConn args dbc

-- FIXME: environment vars may have changed, should use pgsql enquiries
-- for clone.
mkConn :: String -> DbcWrapper -> IO Impl.Connection
mkConn args iconn = withDbcOrDie iconn $ \cconn ->
                    alloca $ \plen ->
                    alloca $ \psqlusmallint ->
                    allocaBytes 128 $ \pbuf ->
    do
       children <- newMVar []
       sqlGetInfo cconn 18 (castPtr pbuf) 127 plen
{-# LINE 104 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_DBMS_VER" (DbcHandle cconn)
       len <- peek plen
       serverver <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 7 (castPtr pbuf) 127 plen
{-# LINE 109 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_DRIVER_VER" (DbcHandle cconn)
       len <- peek plen
       proxiedclientver <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 10 (castPtr pbuf) 127 plen
{-# LINE 114 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_ODBC_VER" (DbcHandle cconn)
       len <- peek plen
       clientver <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 17 (castPtr pbuf) 127 plen
{-# LINE 119 "Database/HDBC/ODBC/Connection.hsc" #-}
         >>= checkError "sqlGetInfo SQL_DBMS_NAME" (DbcHandle cconn)
       len <- peek plen
       clientname <- peekCStringLen (pbuf, fromIntegral len)

       sqlGetInfo cconn 46 (castPtr psqlusmallint)
{-# LINE 124 "Database/HDBC/ODBC/Connection.hsc" #-}
                      0 nullPtr
         >>= checkError "sqlGetInfo SQL_TXN_CAPABLE" (DbcHandle cconn)
       txninfo <- ((peek psqlusmallint)::IO (Word16))
{-# LINE 127 "Database/HDBC/ODBC/Connection.hsc" #-}
       let txnsupport = txninfo /= 0
{-# LINE 128 "Database/HDBC/ODBC/Connection.hsc" #-}

       when txnsupport . void $ fSetAutoCommit cconn False
       return $ Impl.Connection {
                            Impl.getQueryInfo = fGetQueryInfo iconn children,
                            Impl.disconnect = fdisconnect iconn children,
                            Impl.commit = fcommit iconn,
                            Impl.rollback = frollback iconn,
                            Impl.run = frun iconn children,
                            Impl.prepare = newSth iconn children,
                            Impl.clone = connectODBC args,
                            -- FIXME: add clone
                            Impl.hdbcDriverName = "odbc",
                            Impl.hdbcClientVer = clientver,
                            Impl.proxiedClientName = clientname,
                            Impl.proxiedClientVer = proxiedclientver,
                            Impl.dbServerVer = serverver,
                            Impl.dbTransactionSupport = txnsupport,
                            Impl.getTables = fgettables iconn,
                            Impl.describeTable = fdescribetable iconn,
                            Impl.setAutoCommit = \x -> withDbcOrDie iconn $ \conn -> fSetAutoCommit conn x
                           }

--------------------------------------------------
-- Guts here
--------------------------------------------------

frun conn children query args =
    do sth <- newSth conn children query
       res <- execute sth args
       finish sth
       return res

fcommit iconn = withDbcOrDie iconn $ \cconn ->
    sqlEndTran 2 cconn 0
{-# LINE 162 "Database/HDBC/ODBC/Connection.hsc" #-}
    >>= checkError "sqlEndTran commit" (DbcHandle cconn)

frollback iconn = withDbcOrDie iconn $ \cconn ->
    sqlEndTran 2 cconn 1
{-# LINE 166 "Database/HDBC/ODBC/Connection.hsc" #-}
    >>= checkError "sqlEndTran rollback" (DbcHandle cconn)

fdisconnect iconn mchildren  = do
  closeAllChildren mchildren
  freeDbcIfNotAlready True iconn

fGetAutoCommit :: SQLHDBC -> IO Bool
fGetAutoCommit hdbc = do
  value <- with (0 :: SQLUINTEGER) $ \acBuf -> do
    c_sqlGetConnectAttr hdbc sQL_ATTR_AUTOCOMMIT (castPtr acBuf) sQL_IS_UINTEGER nullPtr
      >>= checkError "sqlGetConnectAttr" (DbcHandle hdbc)
    peek acBuf
  return $ value /= sQL_AUTOCOMMIT_OFF

fSetAutoCommit :: SQLHDBC -> Bool -> IO Bool
fSetAutoCommit hdbc newValue = do
  oldValue <- fGetAutoCommit hdbc
  let newValueRaw = if newValue then sQL_AUTOCOMMIT_ON else sQL_AUTOCOMMIT_OFF
  c_sqlSetConnectAttr hdbc sQL_ATTR_AUTOCOMMIT (wordPtrToPtr $ fromIntegral newValueRaw) sQL_IS_UINTEGER
    >>= checkError "sqlSetConnectAttr" (DbcHandle hdbc)
  return oldValue

foreign import ccall safe "sql.h SQLSetEnvAttr"
{-# LINE 189 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlSetEnvAttr :: SQLHENV -> Int32 ->
{-# LINE 190 "Database/HDBC/ODBC/Connection.hsc" #-}
                   Ptr () -> Int32 -> IO Int16
{-# LINE 191 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall safe "sql.h SQLDriverConnect"
{-# LINE 193 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlDriverConnect :: SQLHDBC -> Ptr () -> CString -> Int16
{-# LINE 194 "Database/HDBC/ODBC/Connection.hsc" #-}
                   -> CString -> Int16
{-# LINE 195 "Database/HDBC/ODBC/Connection.hsc" #-}
                   -> Ptr Int16 -> Word16
{-# LINE 196 "Database/HDBC/ODBC/Connection.hsc" #-}
                   -> IO Int16
{-# LINE 197 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall safe "hdbc-odbc-helper.h getSqlOvOdbc3"
  getSqlOvOdbc3 :: Ptr ()

foreign import ccall safe "sql.h SQLEndTran"
{-# LINE 202 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlEndTran :: Int16 -> SQLHDBC -> Int16
{-# LINE 203 "Database/HDBC/ODBC/Connection.hsc" #-}
             -> IO Int16
{-# LINE 204 "Database/HDBC/ODBC/Connection.hsc" #-}

foreign import ccall safe "sql.h SQLGetInfo"
{-# LINE 206 "Database/HDBC/ODBC/Connection.hsc" #-}
  sqlGetInfo :: SQLHDBC -> Word16 -> Ptr () ->
{-# LINE 207 "Database/HDBC/ODBC/Connection.hsc" #-}
                Int16 -> Ptr Int16 ->
{-# LINE 208 "Database/HDBC/ODBC/Connection.hsc" #-}
                IO Int16
{-# LINE 209 "Database/HDBC/ODBC/Connection.hsc" #-}