hsql-odbc 1.7 → 1.7.1
raw patch · 3 files changed
+102/−46 lines, 3 filesdep +old-timedep ~basedep ~hsqlsetup-changednew-uploader
Dependencies added: old-time
Dependency ranges changed: base, hsql
Files
- Database/HSQL/ODBC.hsc +84/−35
- Setup.lhs +12/−8
- hsql-odbc.cabal +6/−3
Database/HSQL/ODBC.hsc view
@@ -1,6 +1,6 @@ {-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ {-| Module : Database.HSQL.ODBC Copyright : (c) Krasimir Angelov 2003 License : BSD-style@@ -11,7 +11,7 @@ The module provides interface to ODBC -}------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ module Database.HSQL.ODBC(connect, driverConnect, module Database.HSQL) where @@ -23,7 +23,7 @@ import Foreign import Foreign.C import Control.Monad(unless)-import Control.Exception(throwDyn)+import Control.OldException(throwDyn) import Control.Concurrent.MVar import System.IO.Unsafe import System.Time@@ -54,38 +54,81 @@ #let CALLCONV = "ccall" #endif -foreign import #{CALLCONV} "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLAllocEnv" + sqlAllocEnv:: Ptr HENV -> IO SQLRETURN+ #ifdef mingw32_HOST_OS-foreign import ccall "HsODBC.h &my_sqlFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())+foreign import ccall "HsODBC.h &my_sqlFreeEnv" + sqlFreeEnv_p:: FunPtr (HENV -> IO ()) #else-foreign import ccall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())+foreign import ccall "HsODBC.h &SQLFreeEnv" + sqlFreeEnv_p:: FunPtr (HENV -> IO ()) #endif-foreign import #{CALLCONV} "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLDriverConnect" sqlDriverConnect :: HDBC -> Ptr () -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> SQLUSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLTables" sqlTables :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLColumns" sqlColumns :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN-foreign import #{CALLCONV} "HsODBC.h SQLMoreResults" sqlMoreResults :: HSTMT -> IO SQLRETURN++foreign import #{CALLCONV} "HsODBC.h SQLAllocConnect" + sqlAllocConnect:: HENV -> Ptr HDBC -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLFreeConnect" + sqlFreeConnect:: HDBC -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLConnect" + sqlConnect:: HDBC -> CString -> Int -> CString -> Int -> CString -> Int + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLDriverConnect" + sqlDriverConnect:: HDBC -> Ptr () -> CString -> SQLSMALLINT -> CString + -> SQLSMALLINT -> Ptr SQLSMALLINT -> SQLUSMALLINT + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLDisconnect" + sqlDisconnect:: HDBC -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLAllocStmt" + sqlAllocStmt:: HDBC -> Ptr HSTMT -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLFreeStmt" + sqlFreeStmt:: HSTMT -> SQLUSMALLINT -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLNumResultCols" + sqlNumResultCols:: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLDescribeCol" + sqlDescribeCol:: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT + -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN + -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLBindCol" + sqlBindCol:: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a + -> SQLLEN -> Ptr SQLINTEGER + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLFetch" + sqlFetch:: HSTMT -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLGetDiagRec" + sqlGetDiagRec:: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString + -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLExecDirect" + sqlExecDirect:: HSTMT -> CString -> Int -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLSetConnectOption" + sqlSetConnectOption:: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLTransact" + sqlTransact:: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLGetData" + sqlGetData:: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () + -> SQLINTEGER -> Ptr SQLINTEGER + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLTables" + sqlTables:: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT + -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLColumns" + sqlColumns:: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT + -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT + -> IO SQLRETURN+foreign import #{CALLCONV} "HsODBC.h SQLMoreResults" + sqlMoreResults:: HSTMT -> IO SQLRETURN+ #if defined(MSSQL_ODBC)-foreign import #{CALLCONV} "HsODBC.h SQLSetStmtAttr" sqlSetStmtAttr :: HSTMT -> SQLINTEGER -> SQLINTEGER -> SQLINTEGER -> IO SQLRETURN +foreign import #{CALLCONV} "HsODBC.h SQLSetStmtAttr" + sqlSetStmtAttr:: HSTMT -> SQLINTEGER -> SQLINTEGER -> SQLINTEGER + -> IO SQLRETURN #endif ------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ -- routines for handling exceptions------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ handleSqlResult :: SQLSMALLINT -> SQLHANDLE -> SQLRETURN -> IO () handleSqlResult handleType handle res@@ -110,18 +153,21 @@ alloca $ \pNative -> allocaBytes 256 $ \pMsg -> alloca $ \pTextLen -> do- res <- sqlGetDiagRec handleType handle 1 pState pNative pMsg 256 pTextLen+ res <- sqlGetDiagRec handleType handle 1 + pState pNative pMsg 256 pTextLen if res == (#const SQL_NO_DATA) then return SqlNoData else do state <- peekCString pState native <- peek pNative msg <- peekCString pMsg- return (SqlError {seState=state, seNativeError=fromIntegral native, seErrorMsg=msg})+ return (SqlError { seState=state+ , seNativeError=fromIntegral native+ , seErrorMsg=msg }) ------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ -- keeper of HENV------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ {-# NOINLINE myEnvironment #-} myEnvironment :: HENVRef@@ -131,9 +177,9 @@ handleSqlResult 0 nullPtr res newForeignPtr sqlFreeEnv_p hEnv ------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ -- Connect/Disconnect------------------------------------------------------------------------------------------+------------------------------------------------------------------------------ -- | Makes a new connection to the ODBC data source connect :: String -- ^ Data source name@@ -144,7 +190,10 @@ withCString server $ \pServer -> withCString user $ \pUser -> withCString authentication $ \pAuthentication ->- sqlConnect hDBC pServer (#const SQL_NTS) pUser (#const SQL_NTS) pAuthentication (#const SQL_NTS)+ sqlConnect hDBC + pServer (#const SQL_NTS) + pUser (#const SQL_NTS) + pAuthentication (#const SQL_NTS) -- | 'driverConnect' is an alternative to 'connect'. It supports data sources that -- require more connection information than the three arguments in 'connect'
Setup.lhs view
@@ -1,18 +1,22 @@ #!/usr/bin/runghc \begin{code}-import Distribution.Simple-import Distribution.Setup+import Distribution.Simple(defaultMainWithHooks ,simpleUserHooks ,preConf)+import Distribution.Simple.Setup(ConfigFlags)+import Distribution.PackageDescription.Parse(writeHookedBuildInfo) import Distribution.PackageDescription-import System.Info+ (HookedBuildInfo ,BuildInfo(extraLibs ,ccOptions) ,emptyBuildInfo)+import System.Info(os) -main = defaultMainWithHooks defaultUserHooks{preConf=configure}+main = defaultMainWithHooks simpleUserHooks{ preConf=configure } where- configure :: [String] -> ConfigFlags -> IO HookedBuildInfo+ configure:: [String]-> ConfigFlags-> IO HookedBuildInfo configure args flags = do- let binfo | os == "mingw32" = emptyBuildInfo{extraLibs=["odbc32"], ccOptions=["-Dmingw32_HOST_OS"]}- | otherwise = emptyBuildInfo{extraLibs=["odbc"]}- hbi = (Just binfo,[])+ let binfo | os == "mingw32" = + emptyBuildInfo{ extraLibs=["odbc32"]+ , ccOptions=["-Dmingw32_HOST_OS"] }+ | otherwise = emptyBuildInfo{ extraLibs=["odbc"] }+ hbi = (Just binfo ,[]) writeHookedBuildInfo "ODBC.buildinfo" hbi return hbi \end{code}
hsql-odbc.cabal view
@@ -1,12 +1,15 @@ name: hsql-odbc-version: 1.7+version: 1.7.1 license: BSD3 author: Krasimir Angelov <kr.angelov@gmail.com>+maintainer: nick.rudnick@googlemail.com category: Database description: ODBC driver for HSQL. exposed-modules:Database.HSQL.ODBC-build-depends: base, hsql+build-depends: base >= 4 && < 5, hsql >= 1.7, old-time >= 1.0.0.1 extensions: ForeignFunctionInterface, CPP-cc-options: -IDatabase/HSQL+include-dirs: Database/HSQL c-sources: Database/HSQL/HsODBC.c extra-source-files: Database/HSQL/HsODBC.h +build-type: Simple+extra-libraries: odbc