diff --git a/Database/HDBC/ODBC/Api/Errors.hs b/Database/HDBC/ODBC/Api/Errors.hs --- a/Database/HDBC/ODBC/Api/Errors.hs +++ b/Database/HDBC/ODBC/Api/Errors.hs @@ -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 diff --git a/Database/HDBC/ODBC/Api/Imports.hsc b/Database/HDBC/ODBC/Api/Imports.hsc --- a/Database/HDBC/ODBC/Api/Imports.hsc +++ b/Database/HDBC/ODBC/Api/Imports.hsc @@ -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} diff --git a/Database/HDBC/ODBC/Connection.hsc b/Database/HDBC/ODBC/Connection.hsc --- a/Database/HDBC/ODBC/Connection.hsc +++ b/Database/HDBC/ODBC/Connection.hsc @@ -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 diff --git a/Database/HDBC/ODBC/Statement.hsc b/Database/HDBC/ODBC/Statement.hsc --- a/Database/HDBC/ODBC/Statement.hsc +++ b/Database/HDBC/ODBC/Statement.hsc @@ -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 diff --git a/Database/HDBC/ODBC/TypeConv.hsc b/Database/HDBC/ODBC/TypeConv.hsc --- a/Database/HDBC/ODBC/TypeConv.hsc +++ b/Database/HDBC/ODBC/TypeConv.hsc @@ -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 #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) diff --git a/Database/HDBC/ODBC/Utils.hs b/Database/HDBC/ODBC/Utils.hs --- a/Database/HDBC/ODBC/Utils.hs +++ b/Database/HDBC/ODBC/Utils.hs @@ -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 diff --git a/HDBC-odbc.cabal b/HDBC-odbc.cabal --- a/HDBC-odbc.cabal +++ b/HDBC-odbc.cabal @@ -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 diff --git a/cbits/hdbc-odbc-helper.c b/cbits/hdbc-odbc-helper.c --- a/cbits/hdbc-odbc-helper.c +++ b/cbits/hdbc-odbc-helper.c @@ -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); } diff --git a/changelog.txt b/changelog.txt --- a/changelog.txt +++ b/changelog.txt @@ -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