module SQL.CLI.ODBC where
import Prelude hiding (fail, log)
import Control.Logging (log)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Fail (MonadFail, fail)
import Data.String (fromString)
import System.IO (hPutStrLn, stderr)
import Foreign.Ptr (wordPtrToPtr)
import SQL.ODBC (sql_attr_odbc_version,
sql_ov_odbc3,
sql_longvarchar,
sql_binary,
sql_longvarbinary,
sql_varbinary,
sql_interval)
import SQL.CLI (SQLHENV, SQLSMALLINT, sqlsetenvattr, sql_handle_env, sql_null_handle, sql_success, sql_success_with_info, sql_invalid_handle, sql_error, sql_char)
import SQL.CLI.Utils (SQLConfig(SQLConfig), allocHandle, displayDiagInfo, toCLIType)
odbcImplementation :: SQLConfig
odbcImplementation = SQLConfig 1 2 3 4 5 6 7 8 9 10 11 12 13 15 16 17 18
setupEnv :: (MonadIO m, MonadFail m) => m SQLHENV
setupEnv = do
liftIO $ log $ fromString "alloc env handle"
henv <- allocHandle sql_handle_env sql_null_handle
liftIO $ log $ fromString $ "allocated environment handle: " ++ (show henv)
liftIO $ log $ fromString "odbc specific - set odbc version env attr"
resultSetEnvOV <- liftIO $ sqlsetenvattr henv sql_attr_odbc_version (wordPtrToPtr $ fromIntegral sql_ov_odbc3) 0
case resultSetEnvOV of x | x == sql_success -> return henv
| x == sql_success_with_info -> do
liftIO $ do
log $ fromString "Set ODBC version generated warnings"
displayDiagInfo sql_handle_env henv
return henv
| x == sql_invalid_handle -> do
liftIO $ log $ fromString "Set ODBC version failed because invalid handle was passed to SetEnvAttr function."
fail "Set ODBC version failed"
| x == sql_error -> do
liftIO $ do
log $ fromString "Set ODBC version failed. Error diagnostics follow:"
displayDiagInfo sql_handle_env henv
fail "Set ODBC version failed"
| otherwise -> do
liftIO $ log $ fromString $ "SetEnvAttr returned unexpected return code: " ++ (show x)
fail "Set ODBC version failed"
toODBCType :: SQLSMALLINT -> SQLSMALLINT
toODBCType t = if t == sql_char
then sql_char
else if clitype == sql_char
then odbctype
else clitype
where
clitype = toCLIType t
odbctype = if elem t [sql_longvarchar, sql_binary, sql_longvarbinary, sql_varbinary, sql_interval]
then t
else sql_char