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) -- | holds information specific to ODBC implementation odbcImplementation :: SQLConfig odbcImplementation = SQLConfig 1 2 3 4 5 6 7 8 9 10 11 12 13 15 16 17 18 -- | helper function to allocate and setup an ODBC environment handle; it displays -- diagnostics on standard error and fails if the handle could not be allocated -- or setting the environment failed; it requires ODBC 3 implementation 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" -- | convert an implementation type identifier to an ODBC known type 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