packages feed

HDBC-odbc 2.5.1.1 → 2.6.0.0

raw patch · 9 files changed

+157/−86 lines, 9 files

Files

Database/HDBC/ODBC/Api/Errors.hs view
@@ -38,20 +38,44 @@ 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 $ \csstate ->+  allocaBytes (6 * sizeOf (undefined :: CWchar)) $ \csstate ->   alloca $ \pnaterr ->-  allocaBytes 1025 $ \csmsg ->+  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 <- peekCWStringLen (csstate, 5)+      state <- peekCWString csstate       nat <- peek pnaterr       msglen <- peek pmsglen-      msgstr <- peekCWStringLen (csmsg, fromIntegral msglen)+      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
Database/HDBC/ODBC/Api/Imports.hsc view
@@ -12,7 +12,11 @@   , c_sqlDisconnect   , c_sqlFreeHandle   , c_sqlFreeStmt+#ifdef mingw32_HOST_OS   , c_sqlGetDiagRecW+#else+  , c_sqlGetDiagRec+#endif   , c_sqlSetConnectAttr   , c_sqlGetConnectAttr   , sQL_ATTR_AUTOCOMMIT@@ -89,11 +93,13 @@ foreign import #{CALLCONV} safe "sql.h SQLDisconnect"   imp_sqlDisconnect :: SQLHDBC -> IO SQLRETURN +c_sqlDisconnect :: SQLHDBC -> IO SQLRETURN c_sqlDisconnect hDbc = do   result <- imp_sqlDisconnect hDbc   hdbcTrace $ printf "SQLDisconnect(%s) returned %d" (show hDbc) result   return result +#ifdef mingw32_HOST_OS foreign import #{CALLCONV} safe "sql.h SQLGetDiagRecW"   imp_sqlGetDiagRecW :: SQLSMALLINT -> Ptr () -> SQLSMALLINT -> CWString                      -> Ptr SQLINTEGER -> CWString -> SQLSMALLINT@@ -103,9 +109,23 @@                  -> CWString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN c_sqlGetDiagRecW handleType handle recNumber sqlState nativeErrorPtr messageText bufferLength textLengthPtr = do   result <- imp_sqlGetDiagRecW handleType handle recNumber sqlState nativeErrorPtr messageText bufferLength textLengthPtr+  hdbcTrace $ printf "SqlGetDiagRecW(%d, %s, %d, %s, %s, %s, %d, %s) returned %d"+                handleType (show handle) recNumber (show sqlState) (show nativeErrorPtr) (show messageText) bufferLength (show textLengthPtr) result+  return result+#else+foreign import #{CALLCONV} safe "sql.h SQLGetDiagRec"+  imp_sqlGetDiagRec :: SQLSMALLINT -> Ptr () -> SQLSMALLINT -> CString+                     -> Ptr SQLINTEGER -> CString -> SQLSMALLINT+                     -> Ptr SQLSMALLINT -> IO SQLRETURN++c_sqlGetDiagRec :: SQLSMALLINT -> Ptr () -> SQLSMALLINT -> CString -> Ptr SQLINTEGER+                 -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN+c_sqlGetDiagRec handleType handle recNumber sqlState nativeErrorPtr messageText bufferLength textLengthPtr = do+  result <- imp_sqlGetDiagRec handleType handle recNumber sqlState nativeErrorPtr messageText bufferLength textLengthPtr   hdbcTrace $ printf "SqlGetDiagRec(%d, %s, %d, %s, %s, %s, %d, %s) returned %d"                 handleType (show handle) recNumber (show sqlState) (show nativeErrorPtr) (show messageText) bufferLength (show textLengthPtr) result   return result+#endif  sQL_CLOSE :: SQLUSMALLINT sQL_CLOSE = #{const SQL_CLOSE}
Database/HDBC/ODBC/Connection.hsc view
@@ -5,7 +5,6 @@ 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@@ -13,12 +12,9 @@ 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@@ -79,7 +75,7 @@   -- Create the Environment Handle   env <- sqlAllocEnv   withEnvOrDie env $ \hEnv ->-    sqlSetEnvAttr hEnv #{const SQL_ATTR_ODBC_VERSION} (getSqlOvOdbc3) 0+    void $ sqlSetEnvAttr hEnv #{const SQL_ATTR_ODBC_VERSION} (getSqlOvOdbc3) 0    -- Create the DBC handle.   dbc <- sqlAllocDbc env@@ -151,20 +147,24 @@ -- Guts here -------------------------------------------------- +frun :: DbcWrapper -> ChildList -> String -> [SqlValue] -> IO Integer frun conn children query args =     do sth <- newSth conn children query        res <- execute sth args        finish sth        return res +fcommit :: DbcWrapper -> IO () fcommit iconn = withDbcOrDie iconn $ \cconn ->     sqlEndTran #{const SQL_HANDLE_DBC} cconn #{const SQL_COMMIT}     >>= checkError "sqlEndTran commit" (DbcHandle cconn) +frollback :: DbcWrapper -> IO () frollback iconn = withDbcOrDie iconn $ \cconn ->     sqlEndTran #{const SQL_HANDLE_DBC} cconn #{const SQL_ROLLBACK}     >>= checkError "sqlEndTran rollback" (DbcHandle cconn) +fdisconnect :: DbcWrapper -> ChildList -> IO () fdisconnect iconn mchildren  = do   closeAllChildren mchildren   freeDbcIfNotAlready True iconn
Database/HDBC/ODBC/Statement.hsc view
@@ -16,19 +16,15 @@ import Database.HDBC.ODBC.Api.Errors import Database.HDBC.ODBC.Api.Imports import Database.HDBC.ODBC.Api.Types-import Database.HDBC.ODBC.Utils import Database.HDBC.ODBC.Log import Database.HDBC.ODBC.TypeConv import Database.HDBC.ODBC.Wrappers -import Foreign.C.String (castCUCharToChar) import Foreign.C.Types-import Foreign.ForeignPtr import Foreign.Ptr-import Control.Applicative import Control.Concurrent.MVar import Foreign.C.String-import Foreign.Marshal+import Foreign.Marshal hiding (void) import Foreign.Storable import Control.Monad import Data.Word@@ -39,11 +35,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BUTF8 import qualified Data.ByteString.Unsafe as B-import Unsafe.Coerce (unsafeCoerce) -import System.IO (hPutStrLn, stderr)-import Debug.Trace- import qualified Data.Foldable as F  #ifdef mingw32_HOST_OS@@ -128,7 +120,7 @@   withStmtOrDie (sstmt sstate) $ \hStmt -> do     hdbcTrace "fgettables got stmt handle"     simpleSqlTables hStmt >>= checkError "gettables simpleSqlTables" (StmtHandle hStmt)-    fgetcolinfo hStmt >>= swapMVar (colinfomv sstate)+    fgetcolinfo hStmt >>= void . swapMVar (colinfomv sstate)   results <- fetchAllRows' $ wrapStmt sstate   return $ map (\x -> fromSql (x !! 2)) results @@ -140,7 +132,7 @@     withStmtOrDie (sstmt sstate) $ \hStmt -> do       hdbcTrace "fdescribetable got stmt handle"       simpleSqlColumns hStmt cs (fromIntegral csl) >>= checkError "fdescribetable simpleSqlColumns" (StmtHandle hStmt)-      fgetcolinfo hStmt >>= swapMVar (colinfomv sstate)+      fgetcolinfo hStmt >>= void . swapMVar (colinfomv sstate)     results <- fetchAllRows' $ wrapStmt sstate     hdbcTrace $ show results     return $ map fromOTypeCol results@@ -173,8 +165,8 @@     case rc of       0 -> do rowcount <- getSqlRowCount hStmt               return (True, fromIntegral rowcount)-      colcount -> do fgetcolinfo hStmt >>= swapMVar (colinfomv sstate)-                     return (False, 0)+      _ -> do fgetcolinfo hStmt >>= void . swapMVar (colinfomv sstate)+              return (False, 0)   when finish $ ffinish sstate   return result @@ -398,6 +390,7 @@         return (mBindCols, bindCols)  -- This is only for String data. For binary fix should be very easy. Just check the column type and use buflen instead of buflen - 1+getLongColData :: SQLHSTMT -> BindCol -> IO SqlValue getLongColData cstmt bindCol = do    let (BindColString buf bufLen col) = bindCol    hdbcTrace $ "buflen: " ++ show bufLen@@ -407,6 +400,7 @@    return $ SqlByteString bs2  +getRestLongColData :: Integral a => SQLHSTMT -> Int16 -> a -> BUTF8.ByteString -> IO BUTF8.ByteString getRestLongColData cstmt cBinding icol acc = do   hdbcTrace "getLongColData"   alloca $ \plen ->@@ -430,6 +424,7 @@  -- TODO: This code does not deal well with data that is extremely large, -- where multiple fetches are required.+getColData :: Integral a => SQLHSTMT -> Int16 -> a -> IO SqlValue getColData cstmt cBinding icol = do   alloca $ \plen ->    allocaBytes colBufSizeDefault $ \buf ->@@ -462,6 +457,7 @@  -- | ffetchrowBaseline is used for benchmarking fetches without the -- overhead of marshalling values.+ffetchrowBaseline :: forall t. SState -> IO (Maybe [t]) ffetchrowBaseline sstate = do   hdbcTrace "ffetchrowBaseline"   result <- withStmtOrDie (sstmt sstate) $ \hStmt -> do@@ -708,84 +704,119 @@  where   col' = fromIntegral col +colBufSizeDefault :: Int colBufSizeDefault = 1024+colBufSizeMaximum :: Int colBufSizeMaximum = 4096 +utf8EncodingMaximum :: Int utf8EncodingMaximum = 6+wcSize :: Int wcSize = 2  -- The functions that follow do the marshalling from C into a Haskell type+mkBindColString :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64) mkBindColString cstmt col mColSize = do   hdbcTrace "mkBindCol: BindColString"   let colSize = min colBufSizeMaximum $ fromMaybe colBufSizeDefault mColSize   (bufLen, buf, pStrLen) <- mallocBuffer (colSize + 1)-  sqlBindCol cstmt col (#{const SQL_C_CHAR}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_CHAR}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColString buf (fromIntegral bufLen) col, pStrLen)++mkBindColStringEC :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64) mkBindColStringEC cstmt col = mkBindColString cstmt col . fmap (* utf8EncodingMaximum)++mkBindColWString :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64) mkBindColWString cstmt col mColSize = do   hdbcTrace "mkBindCol: BindColWString"   let colSize = min colBufSizeMaximum $ fromMaybe colBufSizeDefault mColSize   (bufLen, buf, pStrLen) <- mallocBuffer (colSize + 1)-  sqlBindCol cstmt col (#{const SQL_C_WCHAR}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_WCHAR}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColWString buf (fromIntegral bufLen) col, pStrLen)++mkBindColWStringEC :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64) mkBindColWStringEC cstmt col = mkBindColString cstmt col . fmap extendFactor  where   extendFactor sz = sz * ((utf8EncodingMaximum + wcSize - 1) `quot` wcSize)-mkBindColBit cstmt col mColSize = do++mkBindColBit :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColBit cstmt col _ = do   hdbcTrace "mkBindCol: BindColBit"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_BIT}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_BIT}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColBit buf, pStrLen)-mkBindColTinyInt cstmt col mColSize = do++mkBindColTinyInt :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColTinyInt cstmt col _ = do   hdbcTrace "mkBindCol: BindColTinyInt"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_STINYINT}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_STINYINT}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColTinyInt buf, pStrLen)-mkBindColShort cstmt col mColSize = do++mkBindColShort :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColShort cstmt col _ = do   hdbcTrace "mkBindCol: BindColShort"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_SSHORT}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_SSHORT}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColShort buf, pStrLen)-mkBindColLong cstmt col mColSize = do++mkBindColLong :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColLong cstmt col _ = do   hdbcTrace "mkBindCol: BindColSize"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_SLONG}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_SLONG}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColLong buf, pStrLen)-mkBindColBigInt cstmt col mColSize = do++mkBindColBigInt :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColBigInt cstmt col _ = do   hdbcTrace "mkBindCol: BindColBigInt"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_SBIGINT}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_SBIGINT}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColBigInt buf, pStrLen)-mkBindColFloat cstmt col mColSize = do++mkBindColFloat :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColFloat cstmt col _ = do   hdbcTrace "mkBindCol: BindColFloat"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_FLOAT}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_FLOAT}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColFloat buf, pStrLen)-mkBindColDouble cstmt col mColSize = do++mkBindColDouble :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColDouble cstmt col _ = do   hdbcTrace "mkBindCol: BindColDouble"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_DOUBLE}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_DOUBLE}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColDouble buf, pStrLen)++mkBindColBinary :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64) mkBindColBinary cstmt col mColSize = do   hdbcTrace "mkBindCol: BindColBinary"   let colSize = min colBufSizeMaximum $ fromMaybe colBufSizeDefault mColSize   (bufLen, buf, pStrLen) <- mallocBuffer (colSize + 1)-  sqlBindCol cstmt col (#{const SQL_C_BINARY}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_BINARY}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColBinary buf (fromIntegral bufLen) col, pStrLen)-mkBindColDate cstmt col mColSize = do++mkBindColDate :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColDate cstmt col _ = do   hdbcTrace "mkBindCol: BindColDate"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_TYPE_DATE}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_TYPE_DATE}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColDate buf, pStrLen)-mkBindColTime cstmt col mColSize = do++mkBindColTime :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColTime cstmt col _ = do   hdbcTrace "mkBindCol: BindColTime"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_TYPE_TIME}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_TYPE_TIME}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColTime buf, pStrLen)-mkBindColTimestamp cstmt col mColSize = do++mkBindColTimestamp :: SQLHSTMT -> Word16 -> Maybe Int -> IO (BindCol, Ptr Int64)+mkBindColTimestamp cstmt col _ = do   hdbcTrace "mkBindCol: BindColTimestamp"   (bufLen, buf, pStrLen) <- mallocBuffer 1-  sqlBindCol cstmt col (#{const SQL_C_TYPE_TIMESTAMP}) (castPtr buf) (fromIntegral bufLen) pStrLen+  void $ sqlBindCol cstmt col (#{const SQL_C_TYPE_TIMESTAMP}) (castPtr buf) (fromIntegral bufLen) pStrLen   return (BindColTimestamp buf, pStrLen)++mkBindColGetData :: Word16 -> IO (BindCol, Ptr a) mkBindColGetData col = do   hdbcTrace "mkBindCol: BindColGetData"   return (BindColGetData col, nullPtr)@@ -839,31 +870,31 @@       hdbcTrace $ "bindColToSqlValue BindColWString " ++ show bs ++ " " ++ show strLen       return $ SqlByteString bs   | otherwise = getColData pcstmt #{const SQL_CHAR} col-bindColToSqlValue' _ (BindColBit     buf) strLen = do+bindColToSqlValue' _ (BindColBit     buf) _ = do   bit <- peek buf   hdbcTrace $ "bindColToSqlValue BindColBit " ++ show bit   return $ SqlChar (castCUCharToChar bit)-bindColToSqlValue' _ (BindColTinyInt buf) strLen = do+bindColToSqlValue' _ (BindColTinyInt buf) _ = do   tinyInt <- peek buf   hdbcTrace $ "bindColToSqlValue BindColTinyInt " ++ show tinyInt   return $ SqlChar (castCCharToChar tinyInt)-bindColToSqlValue' _ (BindColShort   buf) strLen = do+bindColToSqlValue' _ (BindColShort   buf) _ = do   short <- peek buf   hdbcTrace $ "bindColToSqlValue BindColShort" ++ show short   return $ SqlInt32 (fromIntegral short)-bindColToSqlValue' _ (BindColLong    buf) strLen = do+bindColToSqlValue' _ (BindColLong    buf) _ = do   long <- peek buf   hdbcTrace $ "bindColToSqlValue BindColLong " ++ show long   return $ SqlInt32 (fromIntegral long)-bindColToSqlValue' _ (BindColBigInt  buf) strLen = do+bindColToSqlValue' _ (BindColBigInt  buf) _ = do   bigInt <- peek buf   hdbcTrace $ "bindColToSqlValue BindColBigInt " ++ show bigInt   return $ SqlInt64 (fromIntegral bigInt)-bindColToSqlValue' _ (BindColFloat   buf) strLen = do+bindColToSqlValue' _ (BindColFloat   buf) _ = do   float <- peek buf   hdbcTrace $ "bindColToSqlValue BindColFloat " ++ show float   return $ SqlDouble (realToFrac float)-bindColToSqlValue' _ (BindColDouble  buf) strLen = do+bindColToSqlValue' _ (BindColDouble  buf) _ = do   double <- peek buf   hdbcTrace $ "bindColToSqlValue BindColDouble " ++ show double   return $ SqlDouble (realToFrac double)@@ -873,17 +904,17 @@       hdbcTrace $ "bindColToSqlValue BindColBinary " ++ show bs       return $ SqlByteString bs   | otherwise = getColData pcstmt (#{const SQL_C_BINARY}) col-bindColToSqlValue' _ (BindColDate buf) strLen = do+bindColToSqlValue' _ (BindColDate buf) _ = do   StructDate year month day <- peek buf   hdbcTrace $ "bindColToSqlValue BindColDate"   return $ SqlLocalDate $ fromGregorian     (fromIntegral year) (fromIntegral month) (fromIntegral day)-bindColToSqlValue' _ (BindColTime buf) strLen = do+bindColToSqlValue' _ (BindColTime buf) _ = do   StructTime hour minute second <- peek buf   hdbcTrace $ "bindColToSqlValue BindColTime"   return $ SqlLocalTimeOfDay $ TimeOfDay     (fromIntegral hour) (fromIntegral minute) (fromIntegral second)-bindColToSqlValue' _ (BindColTimestamp buf) strLen = do+bindColToSqlValue' _ (BindColTimestamp buf) _ = do   StructTimestamp year month day hour minute second nanosecond <- peek buf   hdbcTrace $ "bindColToSqlValue BindColTimestamp"   return $ SqlLocalTime $ LocalTime@@ -902,8 +933,8 @@                          alloca $ \datatypeptr ->                          alloca $ \colsizeptr ->                          alloca $ \nullableptr ->-              do sqlDescribeCol cstmt icol cscolname 127 colnamelp-                                datatypeptr colsizeptr nullPtr nullableptr+              do void $ sqlDescribeCol cstmt icol cscolname 127 colnamelp+                                       datatypeptr colsizeptr nullPtr nullableptr                  colnamelen <- peek colnamelp                  colnamebs <- B.packCStringLen (cscolname, fromIntegral colnamelen)                  let colname = BUTF8.toString colnamebs@@ -934,11 +965,6 @@     c_sqlFreeStmt hStmt sQL_UNBIND >>= checkError "fexecute c_sqlFreeStmt sQL_UNBIND" (StmtHandle hStmt)     c_sqlFreeStmt hStmt sQL_RESET_PARAMS >>= checkError "fexecute c_sqlFreeStmt sQL_RESET_PARAMS" (StmtHandle hStmt)   freeBoundCols sstate--ffinalize :: SState -> IO ()-ffinalize sstate = do-  ffinish sstate-  freeStmtIfNotAlready $ sstmt sstate  foreign import #{CALLCONV} safe "sql.h SQLDescribeCol"   sqlDescribeCol :: SQLHSTMT
Database/HDBC/ODBC/TypeConv.hsc view
@@ -4,27 +4,9 @@ module Database.HDBC.ODBC.TypeConv(fromOTypeInfo, fromOTypeCol) where import Database.HDBC.Types import Database.HDBC-import Database.HDBC.DriverUtils-import Database.HDBC.ODBC.Api.Types-import Database.HDBC.ODBC.Utils-import Foreign.C.Types-import Foreign.ForeignPtr-import Foreign.Ptr-import Control.Concurrent.MVar-import Foreign.C.String-import Foreign.Marshal-import Foreign.Storable-import Control.Monad-import Data.List import Data.Word import Data.Int-import Control.Exception-import System.IO-import Data.Maybe -l _ = return ()--- l m = hPutStrLn stderr ("\n" ++ m)- #ifdef mingw32_HOST_OS #include <windows.h> #endif@@ -50,7 +32,8 @@                 }     ) -fromOTypeCol (_:_:_:colname:datatype:_:colsize:buflen:decdig:precrad:nullable:_:_:_:subtype:octetlen:_) =+fromOTypeCol :: [SqlValue] -> (String, SqlColDesc)+fromOTypeCol (_:_:_:colname:datatype:_:colsize:_:_:_:nullable:_:_:_:_:_:_) =     fromOTypeInfo (fromSql colname)                   (fromIntegral ((fromSql datatype)::Int))                   (fromSql colsize)
Database/HDBC/ODBC/Utils.hs view
@@ -2,8 +2,6 @@ -} module Database.HDBC.ODBC.Utils where import Foreign.Ptr-import Database.HDBC.ODBC.Api.Types-import Foreign.C.Types import Control.Exception import Foreign.Marshal.Array
HDBC-odbc.cabal view
@@ -1,5 +1,5 @@ name:          HDBC-odbc-version:       2.5.1.1+version:       2.6.0.0 cabal-version: >=1.8 build-type:    Simple license:       BSD3
cbits/hdbc-odbc-helper.c view
@@ -14,10 +14,10 @@ }  SQLRETURN simpleSqlTables(SQLHSTMT stmt) {-  return SQLTables(stmt, NULL, 0, NULL, 0, "%", 1, "TABLE", 5);+  return SQLTables(stmt, NULL, 0, NULL, 0, (SQLCHAR *)"%", 1, (SQLCHAR *)"TABLE", 5); }  SQLRETURN simpleSqlColumns(SQLHSTMT stmt, SQLCHAR *tablename,                            SQLSMALLINT tnlen) {-  return SQLColumns(stmt, NULL, 0, NULL, 0, tablename, tnlen, "%", 1);+  return SQLColumns(stmt, NULL, 0, NULL, 0, tablename, tnlen, (SQLCHAR *)"%", 1); }
changelog.txt view
@@ -1,3 +1,23 @@+2.6.0.0 - 8 Apr 2019++  * Only use Unicode API for getting diagnostic messages when on Windows,+    switched to non-Unicode API on other OS.++2.5.1.1 - 6 Apr 2019++  * Support for fetching errors from compound statements+  * Fix segfault when statement gets finalized by GC during execution of another+    one on same connection.++2.5.0.1 - 24 Nov 2016++  * Haddock fixes and documentation updates.++2.5.0.0 - 9 Dec 2015++  * Support for Unicode diagnostic messages on Windows.+  * Added support for getting and setting AutoCommit flag.+ 2.4.0.1 - 15 May 2015    * Switched to using UTF-8 encoding for binding WCHAR_T values on Linux. Earlier version tried