module SQL.CLI.ODBC where

import Prelude hiding (fail)

import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Fail (MonadFail, fail)

import System.IO (hPutStrLn, stderr)

import Foreign.Ptr (wordPtrToPtr)

import SQL.ODBC (sql_attr_odbc_version, sql_ov_odbc3)
import SQL.CLI (SQLHENV, sqlsetenvattr, sql_handle_env, sql_null_handle, sql_success, sql_success_with_info, sql_invalid_handle, sql_error)
import SQL.CLI.Utils (SQLConfig(SQLConfig), allocHandle, displayDiagInfo)

-- | 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 $ hPutStrLn stderr "alloc env handle"
  henv <- allocHandle sql_handle_env sql_null_handle
  liftIO $ hPutStrLn stderr "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
                                 hPutStrLn stderr "Set ODBC version generated warnings"
                                 displayDiagInfo sql_handle_env henv
                               return henv
                           | x == sql_invalid_handle -> do
                               liftIO $ hPutStrLn stderr "Set ODBC version failed because invalid handle was passed to SetEnvAttr function."
                               fail "Set ODBC version failed"
                           | x == sql_error -> do
                               liftIO $ do
                                 hPutStrLn stderr "Set ODBC version failed. Error diagnostics follow:"
                                 displayDiagInfo sql_handle_env henv
                               fail "Set ODBC version failed"
                           | otherwise -> do
                               liftIO $ hPutStrLn stderr $ "SetEnvAttr returned unexpected return code: " ++ (show x)
                               fail "Set ODBC version failed"