Errors.hs

{-# LANGUAGE CPP, DoAndIfThenElse #-}
module Database.HDBC.ODBC.Api.Errors
  ( checkError
  , raiseError
  , sqlSucceeded
  ) where

import Control.Monad (unless)
import Database.HDBC (SqlError (..), throwSqlError)
import Database.HDBC.ODBC.Api.Imports
import Database.HDBC.ODBC.Api.Types
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable

checkError :: String -> AnyHandle -> SQLRETURN -> IO ()
checkError msg o res =
  unless (sqlSucceeded res) $ raiseError msg res o

raiseError :: String -> SQLRETURN -> AnyHandle -> IO a
raiseError msg code cconn = do
    info <- getDiag ht hp 1
    throwSqlError SqlError
      { seState = show (map fst info)
      , seNativeError = fromIntegral code
      , seErrorMsg = msg ++ ": " ++ show (map snd info)
      }
  where
    (ht, hp) = case cconn of
                 EnvHandle c -> (sQL_HANDLE_ENV, castPtr c)
                 DbcHandle c -> (sQL_HANDLE_DBC, castPtr c)
                 StmtHandle c -> (sQL_HANDLE_STMT, castPtr c)

foreign import ccall safe "sqlSucceeded"
  c_sqlSucceeded :: SQLRETURN -> CInt

sqlSucceeded :: SQLRETURN -> Bool
sqlSucceeded x = c_sqlSucceeded x /= 0

-- ODBC uses Windows unicode convention (i.e. UCS-2 encoding and
-- 2-byte wchar_t), and is incompatible with Unix wchar_t.  See
-- https://www.easysoft.com/developer/interfaces/odbc/linux.html#unicode_unixodbc
-- for more information.
#ifdef mingw32_HOST_OS
getDiag :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> IO [(String, String)]
getDiag ht hp irow =
  allocaBytes (6 * sizeOf (undefined :: CWchar)) $ \csstate ->
  alloca $ \pnaterr ->
  allocaBytes (1024 * sizeOf (undefined :: CWchar)) $ \csmsg ->
  alloca $ \pmsglen -> do
    ret <- c_sqlGetDiagRecW ht hp irow csstate pnaterr csmsg 1024 pmsglen
    if sqlSucceeded ret
     then do
      state <- peekCWString csstate
      nat <- peek pnaterr
      msglen <- peek pmsglen
      msgstr <- peekCWString csmsg
      next <- getDiag ht hp (irow + 1)
      return $ (state, show nat ++ ": " ++ msgstr) : next
    else
      return []
#else
getDiag :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> IO [(String, String)]
getDiag ht hp irow =
  allocaBytes 6 $ \csstate ->
  alloca $ \pnaterr ->
  allocaBytes 1024 $ \csmsg ->
  alloca $ \pmsglen -> do
    ret <- c_sqlGetDiagRec ht hp irow csstate pnaterr csmsg 1024 pmsglen
    if sqlSucceeded ret
     then do
      state <- peekCString csstate
      nat <- peek pnaterr
      msglen <- peek pmsglen
      msgstr <- peekCString csmsg
      next <- getDiag ht hp (irow + 1)
      return $ (state, show nat ++ ": " ++ msgstr) : next
    else
      return []
#endif