diff --git a/Database/Enumerator.lhs b/Database/Enumerator.lhs --- a/Database/Enumerator.lhs +++ b/Database/Enumerator.lhs @@ -79,6 +79,7 @@ > > -- * Sessions and Transactions > DBM -- The data constructor is not exported +> , IE.ISession, IE.ConnectA > , withSession, withContinuedSession > , commit, rollback, beginTransaction > , withTransaction @@ -86,25 +87,32 @@ > , execDDL, execDML, inquire > > -- * Exceptions and handlers -> , DBException(..) +> , IE.DBException(..) > , formatDBException, basicDBExceptionReporter > , reportRethrow, reportRethrowMsg > , catchDB, catchDBError, ignoreDBError, IE.throwDB +> , IE.ColNum, IE.RowNum +> , IE.SqlState, IE.SqlStateClass, IE.SqlStateSubClass > > -- * Preparing and Binding -> , PreparedStmt(..) -- data constructor not exported +> , IE.PreparedStmt -- data constructor not exported > , withPreparedStatement -> , withBoundStatement, IE.bindP +> , withBoundStatement +> , IE.Statement, IE.Command, IE.EnvInquiry +> , IE.PreparationA, IE.IPrepared +> , IE.BindA, IE.DBBind, IE.bindP > > -- * Iteratees and Cursors -> , doQuery +> , IE.IQuery, doQuery, IE.DBType > , IterResult, IterAct > , IE.currentRowNum, NextResultSet(..), RefCursor(..) > , cursorIsEOF, cursorCurrent, cursorNext > , withCursor +> , IE.Position > > -- * Utilities > , ifNull, result, result' + > ) where > import Prelude hiding (catch) @@ -119,7 +127,6 @@ > import Control.Monad.Reader > import Control.Exception.MonadIO > import qualified Database.InternalEnumerator as IE -> import Database.InternalEnumerator (DBException(..)) ----------------------------------------------------------- @@ -138,7 +145,7 @@ | Catch 'Database.InteralEnumerator.DBException's thrown in the 'DBM' monad. -> catchDB :: CaughtMonadIO m => m a -> (DBException -> m a) -> m a +> catchDB :: CaughtMonadIO m => m a -> (IE.DBException -> m a) -> m a > catchDB action handler = gcatch action $ \e -> > maybe (throw e) handler (dynExceptions e >>= fromDynamic) @@ -146,43 +153,43 @@ |This simple handler reports the error to @stdout@ and swallows it i.e. it doesn't propagate. -> basicDBExceptionReporter :: CaughtMonadIO m => DBException -> m () +> basicDBExceptionReporter :: CaughtMonadIO m => IE.DBException -> m () > basicDBExceptionReporter e = liftIO (putStrLn (formatDBException e)) | This handler reports the error and propagates it (usually to force the program to halt). -> reportRethrow :: CaughtMonadIO m => DBException -> m a +> reportRethrow :: CaughtMonadIO m => IE.DBException -> m a > --reportRethrow e = basicDBExceptionReporter e >> IE.throwDB e > reportRethrow e = reportRethrowMsg "" e | Same as reportRethrow, but you can prefix some text to the error (perhaps to indicate which part of your program raised it). -> reportRethrowMsg :: CaughtMonadIO m => String -> DBException -> m a +> reportRethrowMsg :: CaughtMonadIO m => String -> IE.DBException -> m a > reportRethrowMsg m e = liftIO (putStr m) >> basicDBExceptionReporter e >> IE.throwDB e | A show for 'Database.InteralEnumerator.DBException's. -> formatDBException :: DBException -> String -> formatDBException (DBError (ssc, sssc) e m) = +> formatDBException :: IE.DBException -> String +> formatDBException (IE.DBError (ssc, sssc) e m) = > ssc ++ sssc ++ " " ++ (show e) ++ ": " ++ m -> formatDBException (DBFatal (ssc, sssc) e m) = +> formatDBException (IE.DBFatal (ssc, sssc) e m) = > ssc ++ sssc ++ " " ++ (show e) ++ ": " ++ m -> formatDBException (DBUnexpectedNull r c) = +> formatDBException (IE.DBUnexpectedNull r c) = > "Unexpected null in row " ++ (show r) ++ ", column " ++ (show c) ++ "." -> formatDBException (DBNoData) = "Fetch: no more data." +> formatDBException (IE.DBNoData) = "Fetch: no more data." |If you want to trap a specific error number, use this. It passes anything else up. > catchDBError :: (CaughtMonadIO m) => -> Int -> m a -> (DBException -> m a) -> m a +> Int -> m a -> (IE.DBException -> m a) -> m a > catchDBError n action handler = catchDB action > (\dberror -> > case dberror of -> DBError ss e m | e == n -> handler dberror +> IE.DBError ss e m | e == n -> handler dberror > _ | otherwise -> IE.throwDB dberror > ) @@ -330,17 +337,16 @@ -- ** Statements; Prepared statements -------------------------------------------------------------------- -> newtype PreparedStmt mark stmt = PreparedStmt stmt - > executePreparation :: IE.IPrepared stmt sess bstmt bo => -> IE.PreparationA sess stmt -> DBM mark sess (PreparedStmt mark stmt) +> IE.PreparationA sess stmt -> DBM mark sess (IE.PreparedStmt mark stmt) > executePreparation (IE.PreparationA action) = -> DBM( ask >>= \sess -> lift $ action sess >>= return . PreparedStmt) +> DBM( ask >>= \sess -> lift $ action sess >>= return . IE.PreparedStmt) -> data NextResultSet mark stmt = NextResultSet (PreparedStmt mark stmt) +> data NextResultSet mark stmt = NextResultSet (IE.PreparedStmt mark stmt) > data RefCursor a = RefCursor a + The exception handling in withPreparedStatement looks awkward, but there's a good reason... @@ -365,7 +371,7 @@ > => IE.PreparationA sess stmt > -- ^ preparation action to create prepared statement; > -- this action is usually created by @prepareQuery\/Command@ -> -> (PreparedStmt mark stmt -> DBM mark sess a) +> -> (IE.PreparedStmt mark stmt -> DBM mark sess a) > -- ^ DBM action that takes a prepared statement > -> DBM mark sess a > withPreparedStatement pa action = do @@ -380,8 +386,8 @@ Not exported. > destroyStmt :: (IE.ISession sess, IE.IPrepared stmt sess bstmt bo) -> => PreparedStmt mark stmt -> DBM mark sess () -> destroyStmt (PreparedStmt stmt) = DBM( ask >>= \s -> lift $ IE.destroyStmt s stmt ) +> => IE.PreparedStmt mark stmt -> DBM mark sess () +> destroyStmt (IE.PreparedStmt stmt) = DBM( ask >>= \s -> lift $ IE.destroyStmt s stmt) @@ -402,14 +408,14 @@ > withBoundStatement :: > (Typeable a, IE.IPrepared stmt s bstmt bo) -> => PreparedStmt mark stmt +> => IE.PreparedStmt mark stmt > -- ^ prepared statement created by withPreparedStatement > -> [IE.BindA s stmt bo] > -- ^ bind values > -> (bstmt -> DBM mark s a) > -- ^ action to run over bound statement > -> DBM mark s a -> withBoundStatement (PreparedStmt stmt) ba f = +> withBoundStatement (IE.PreparedStmt stmt) ba f = > DBM ( ask >>= \s -> > lift $ IE.bindRun s stmt ba (\b -> runReaderT (unDBM (f b)) s)) @@ -583,7 +589,7 @@ > -> DBM mark s (DBCursor mark (DBM mark s) a) > cursorNext (DBCursor ref) = do > (_, maybeF) <- liftIO $ readIORef ref -> maybe (IE.throwDB DBNoData) ($ True) maybeF +> maybe (IE.throwDB IE.DBNoData) ($ True) maybeF Returns the cursor. The return value is usually ignored. diff --git a/Database/InternalEnumerator.lhs b/Database/InternalEnumerator.lhs --- a/Database/InternalEnumerator.lhs +++ b/Database/InternalEnumerator.lhs @@ -20,6 +20,7 @@ > ISession(..), ConnectA(..) > , Statement(..), Command(..), EnvInquiry(..) > , PreparationA(..), IPrepared(..) +> , PreparedStmt(..) > , BindA(..), DBBind(..) > , IsolationLevel(..) > , Position @@ -215,6 +216,7 @@ ------------------------------------------------------------------------ Prepared commands and statements +> newtype PreparedStmt mark stmt = PreparedStmt stmt | This type is not visible to the end user (cf. ConnectA). It forms a private `communication channel' between Database.Enumerator and a back end. @@ -241,6 +243,7 @@ > -- (so many result-sets are created+destroyed), and then destroy it, > -- so it has a lifecycle independent of Queries. > destroyStmt :: sess -> stmt -> IO () + | The binding object (bo) below is very abstract, on purpose. It may be |IO a|, it may be String, it may be a function, etc. diff --git a/Database/ODBC/OdbcFunctions.hsc b/Database/ODBC/OdbcFunctions.hsc --- a/Database/ODBC/OdbcFunctions.hsc +++ b/Database/ODBC/OdbcFunctions.hsc @@ -1,945 +1,1021 @@ - -{-# OPTIONS -ffi #-} -{-# OPTIONS -fglasgow-exts #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -#ifdef mingw32_HOST_OS -#include -#endif -#include -#include - -#ifdef mingw32_HOST_OS -#let CALLCONV = "stdcall" -#else -#let CALLCONV = "ccall" -#endif - -{- -http://msdn.microsoft.com/library/default.asp?url=/library/en-us/odbc/htm/odbcodbc_api_reference.asp -http://www.dbmaker.com.tw/reference/manuals/odbc/odbc_chap_04.html --} - - --- | --- Module : Database.ODBC.OdbcFunctions --- Copyright : (c) 2007 Oleg Kiselyov, Alistair Bayley --- License : BSD-style --- Maintainer : oleg@pobox.com, alistair@abayley.org --- Stability : experimental --- Portability : non-portable --- --- Wrappers for ODBC FFI functions, plus buffer marshaling. - -module Database.ODBC.OdbcFunctions where - -import Control.Exception -import Control.Monad -import Data.Dynamic -import Data.Time -import Database.Util -import Foreign -import Foreign.C -import Foreign.C.UTF8 - -data HandleObj = HandleObj -type Handle = Ptr HandleObj -data EnvObj = EnvObj -type EnvHandle = Ptr EnvObj -data ConnObj = ConnObj -type ConnHandle = Ptr ConnObj -data StmtObj = StmtObj -type StmtHandle = Ptr StmtObj -type WindowHandle = Ptr () -data Buffer = Buffer -type BufferFPtr = ForeignPtr Buffer -type SizeFPtr = ForeignPtr SqlLen - -data BindBuffer = BindBuffer - { bindBufPtr :: BufferFPtr - , bindBufSzPtr :: SizeFPtr - , bindBufSize :: SqlLen - } - -type SqlInteger = #{type SQLINTEGER} -type SqlUInteger = #{type SQLUINTEGER} -type SqlSmallInt = #{type SQLSMALLINT} -type SqlUSmallInt = #{type SQLUSMALLINT} -type SqlLen = #{type SQLLEN} -type SqlULen = #{type SQLULEN} -type SqlReturn = SqlSmallInt -type SqlHandleType = SqlSmallInt -type SqlDataType = SqlSmallInt -type SqlCDataType = SqlSmallInt -type SqlParamDirection = SqlSmallInt - --- Return codes from API calls - -( - sqlRcInvalidHandle : - sqlRcStillExecuting : - sqlRcSuccess : - sqlRcSuccessWithInfo : - sqlRcError : - sqlRcNeedData : - sqlRcNoData : --- []) = [-2,-1,0,1,2,99,100] :: [SqlReturn] - []) = - ( - #{const SQL_INVALID_HANDLE} : - #{const SQL_STILL_EXECUTING} : - #{const SQL_SUCCESS} : - #{const SQL_SUCCESS_WITH_INFO} : - #{const SQL_ERROR} : - #{const SQL_NEED_DATA} : - #{const SQL_NO_DATA} : - []) :: [SqlReturn] - -showReturnCode rc - | rc == #{const SQL_INVALID_HANDLE} = "SQL_INVALID_HANDLE" - | rc == #{const SQL_STILL_EXECUTING} = "SQL_STILL_EXECUTING" - | rc == #{const SQL_SUCCESS} = "SQL_SUCCESS" - | rc == #{const SQL_SUCCESS_WITH_INFO} = "SQL_SUCCESS_WITH_INFO" - | rc == #{const SQL_ERROR} = "SQL_ERROR" - | rc == #{const SQL_NEED_DATA} = "SQL_NEED_DATA" - | rc == #{const SQL_NO_DATA} = "SQL_NO_DATA" - | otherwise = "UNKNOWN_RETURN_CODE" - --- There are only four handle types in ODBC. - -( - sqlHTypeEnv : - sqlHTypeConn : - sqlHTypeStmt : - sqlHTypeDesc : --- []) = [1..4] :: [SqlHandleType] - []) = - ( - #{const SQL_HANDLE_ENV} : - #{const SQL_HANDLE_DBC} : - #{const SQL_HANDLE_STMT} : - #{const SQL_HANDLE_DESC} : - []) :: [SqlHandleType] - -sqlDriverNoPrompt :: SqlUSmallInt -sqlDriverNoPrompt = #{const SQL_DRIVER_NOPROMPT} - -sqlNullTermedString :: SqlInteger -sqlNullTermedString = #{const SQL_NTS} - -sqlNullData :: SqlLen -sqlNullData = #{const SQL_NULL_DATA} - -sqlTransCommit :: SqlSmallInt -sqlTransCommit = #{const SQL_COMMIT} - -sqlTransRollback :: SqlSmallInt -sqlTransRollback = #{const SQL_ROLLBACK} - -sqlAutoCommitOn, sqlAutoCommitOff :: SqlInteger -sqlAutoCommitOn = #{const SQL_AUTOCOMMIT_ON} -sqlAutoCommitOff = #{const SQL_AUTOCOMMIT_OFF} - --- These are attribute types, which are passed as the second parameter --- to sqlSetEnvAttr. - -( - sqlAttrOdbcVersion : - sqlAttrAutoCommit : - sqlAttrTxnIsolation : - []) = - ( - #{const SQL_ATTR_ODBC_VERSION} : - #{const SQL_ATTR_AUTOCOMMIT} : - #{const SQL_ATTR_TXN_ISOLATION} : - []) :: [SqlInteger] - --- These are attribute values, which are passed as the third parameter --- to sqlSetEnvAttr. Obviously that must accompany the relevant --- attribute type. - -( - sqlOvOdbc3 : - sqlTxnCapable : - sqlDefaultTxnIsolation : - sqlTxnIsolationOption : - sqlTxnReadUncommitted : - sqlTxnReadCommitted : - sqlTxnRepeatableRead : - sqlTxnSerializable : - []) = - ( - #{const SQL_OV_ODBC3} : -- 3 (UL) - #{const SQL_TXN_CAPABLE} : -- 46 - #{const SQL_DEFAULT_TXN_ISOLATION} : -- 26 - #{const SQL_TXN_ISOLATION_OPTION} : -- 72 - #{const SQL_TXN_READ_UNCOMMITTED} : -- 1 - #{const SQL_TXN_READ_COMMITTED} : -- 2 - #{const SQL_TXN_REPEATABLE_READ} : -- 4 - #{const SQL_TXN_SERIALIZABLE} : -- 8 - []) :: [SqlInteger] - - --- ODBC SQL data types -( - sqlDTypeString : - sqlDTypeInt : - sqlDTypeBinary : - sqlDTypeDouble : - sqlDTypeDate : - sqlDTypeTime : - sqlDTypeTimestamp : - sqlDTypeCursor : - []) = - ( - #{const SQL_CHAR} : -- 1 - #{const SQL_INTEGER} : -- 4 - #{const SQL_BINARY} : -- -2 - #{const SQL_DOUBLE} : -- 8 - #{const SQL_TYPE_DATE} : -- 9 - #{const SQL_TYPE_TIME} : -- 10 - #{const SQL_TYPE_TIMESTAMP} : -- 11 - #{const SQL_CURSOR_TYPE} : -- 6 - []) :: [SqlDataType] - --- host language (C) data types - -( - sqlCTypeString : - sqlCTypeInt : - sqlCTypeBinary : - sqlCTypeDouble : - sqlCTypeDate : - sqlCTypeTime : - sqlCTypeTimestamp : - []) = - ( - #{const SQL_C_CHAR} : - #{const SQL_C_LONG} : - #{const SQL_C_BINARY} : - #{const SQL_C_DOUBLE} : - #{const SQL_C_TYPE_DATE} : - #{const SQL_C_TYPE_TIME} : - #{const SQL_C_TYPE_TIMESTAMP} : - []) :: [SqlCDataType] - -{- -#define SQL_C_BINARY SQL_BINARY -#define SQL_C_BIT SQL_BIT -#define SQL_C_BOOKMARK SQL_C_ULONG -#define SQL_C_CHAR SQL_CHAR -#define SQL_C_DATE SQL_DATE -#define SQL_C_DEFAULT 99 -#define SQL_C_DOUBLE SQL_DOUBLE -#define SQL_C_FLOAT SQL_REAL -#define SQL_C_LONG SQL_INTEGER -#define SQL_C_SHORT SQL_SMALLINT -#define SQL_C_SLONG (SQL_C_LONG+SQL_SIGNED_OFFSET) -#define SQL_C_SSHORT (SQL_C_SHORT+SQL_SIGNED_OFFSET) -#define SQL_C_STINYINT (SQL_TINYINT+SQL_SIGNED_OFFSET) -#define SQL_C_TIME SQL_TIME -#define SQL_C_TIMESTAMP SQL_TIMESTAMP -#define SQL_C_TINYINT SQL_TINYINT -#define SQL_C_ULONG (SQL_C_LONG+SQL_UNSIGNED_OFFSET) -#define SQL_C_USHORT (SQL_C_SHORT+SQL_UNSIGNED_OFFSET) -#define SQL_C_UTINYINT (SQL_TINYINT+SQL_UNSIGNED_OFFSET) --} - -( - sqlParamInput : - sqlParamInputOutput : - sqlParamOutput : - sqlParamDefault : - sqlParamUnknown : - [] ) = - ( - #{const SQL_PARAM_INPUT} : - #{const SQL_PARAM_INPUT_OUTPUT} : - #{const SQL_PARAM_OUTPUT} : - #{const SQL_PARAM_TYPE_DEFAULT} : - #{const SQL_PARAM_TYPE_UNKNOWN} : - [] ) :: [SqlParamDirection] - - -data OdbcException = OdbcException Int String String [OdbcException] - deriving (Typeable) - -instance Show OdbcException where - show (OdbcException i st s _) = "OdbcException " - ++ (show i) ++ " " ++ st ++ " " ++ s - -catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a -catchOdbc = catchDyn - -throwOdbc :: OdbcException -> a -throwOdbc = throwDyn - --- define SQL_SUCCEEDED(rc) (((rc)&(~1))==0) -sqlSucceeded rc = rc == sqlRcSuccess || rc == sqlRcSuccessWithInfo - -type MyCString = CString -type MyCStringLen = CStringLen -myPeekCStringLen p = peekUTF8StringLen p -myWithCString s = withUTF8String s -myWithCStringLen s = withUTF8StringLen s ---myPeekCStringLen p = peekCStringLen p ---myWithCString s = withCString s ---myWithCStringLen s = withCStringLen s - -getDiagRec :: SqlReturn -> SqlHandleType -> Handle -> SqlSmallInt -> IO [OdbcException] -getDiagRec retcode htype handle row = - allocaBytes 6 $ \cstrState -> do - alloca $ \errorNumPtr -> do - allocaBytes 1025 $ \cstrMsg -> do - alloca $ \msgLenPtr -> do - rc <- sqlGetDiagRec htype handle row cstrState errorNumPtr cstrMsg 1024 msgLenPtr - --putStrLn ("getDiagRec: rc=" ++ show rc) - case () of - _ | rc == sqlRcSuccess -> do - errnum <- peek errorNumPtr - state <- myPeekCStringLen (cstrState, 5) - msglen <- peek msgLenPtr - --putStrLn ("getDiagRec: msglen=" ++ show msglen) - msg <- myPeekCStringLen (cstrMsg, fromIntegral msglen) - --putStrLn ("getDiagRec: msg=" ++ msg) - more <- getDiagRec retcode htype handle (row+1) - return ((OdbcException (fromIntegral errnum) state msg []) : more) - | rc == sqlRcNoData -> return [] - | otherwise -> return [OdbcException (fromIntegral rc) "01000" (showReturnCode retcode) []] - -checkError :: SqlReturn -> SqlHandleType -> Handle -> IO () -checkError rc htype handle = - when (rc /= sqlRcSuccess && rc /= sqlRcSuccessWithInfo) - (do - exs <- getDiagRec rc htype handle 1 - if null exs - then throwOdbc (OdbcException (fromIntegral rc) "01000" - ("No error messages for return code " ++ show rc ++ " (" ++ showReturnCode rc ++ ")") []) - else do - let (OdbcException i st s _) = head exs - throwOdbc (OdbcException i st s (tail exs)) - ) - -allocHdl :: (Storable a) => Handle -> SqlHandleType -> IO a -allocHdl h htype = do - alloca $ \hptr -> do - rc <- sqlAllocHandle htype h (castPtr hptr) - checkError rc htype h - peek hptr - -allocEnv :: IO EnvHandle -allocEnv = allocHdl nullPtr sqlHTypeEnv - -allocConn :: EnvHandle -> IO ConnHandle -allocConn env = allocHdl (castPtr env) sqlHTypeConn - -allocStmt :: ConnHandle -> IO StmtHandle -allocStmt conn = allocHdl (castPtr conn) sqlHTypeStmt - -freeHelper :: SqlHandleType -> Handle -> IO () -freeHelper htype h = do - rc <- sqlFreeHandle htype h - checkError rc htype h - -freeEnv :: EnvHandle -> IO () -freeEnv env = freeHelper sqlHTypeEnv (castPtr env) - -freeConn :: ConnHandle -> IO () -freeConn conn = freeHelper sqlHTypeConn (castPtr conn) - -freeStmt :: StmtHandle -> IO () -freeStmt stmt = freeHelper sqlHTypeStmt (castPtr stmt) - -int2Ptr :: SqlInteger -> Ptr () -int2Ptr i = plusPtr nullPtr (fromIntegral i) - -setOdbcVer :: EnvHandle -> IO () -setOdbcVer env = do - rc <- sqlSetEnvAttr env sqlAttrOdbcVersion (int2Ptr sqlOvOdbc3) 0 - checkError rc sqlHTypeEnv (castPtr env) - -connect :: ConnHandle -> String -> IO String -connect conn connstr = do - myWithCStringLen connstr $ \(cstr, clen) -> do - allocaBytes 1000 $ \outConnStr -> do - alloca $ \ptrOutLen -> do - rc <- sqlDriverConnect conn nullPtr cstr (fromIntegral clen) - outConnStr 1000 ptrOutLen sqlDriverNoPrompt - checkError rc sqlHTypeConn (castPtr conn) - outLen <- peek ptrOutLen - myPeekCStringLen (outConnStr, fromIntegral outLen) - -disconnect :: ConnHandle -> IO () -disconnect conn = do - rc <- sqlDisconnect conn - checkError rc sqlHTypeConn (castPtr conn) - - -prepareStmt :: StmtHandle -> String -> IO () -prepareStmt stmt sqltext = do - myWithCString sqltext $ \cstr -> do - rc <- sqlPrepare stmt cstr sqlNullTermedString - checkError rc sqlHTypeStmt (castPtr stmt) - -executeStmt :: StmtHandle -> IO () -executeStmt stmt = do - rc <- sqlExecute stmt - checkError rc sqlHTypeStmt (castPtr stmt) - -closeCursor :: StmtHandle -> IO () -closeCursor stmt = do - rc <- sqlCloseCursor stmt - checkError rc sqlHTypeStmt (castPtr stmt) - -rowCount :: StmtHandle -> IO Int -rowCount stmt = do - alloca $ \rcptr -> do - rc <- sqlRowCount stmt rcptr - checkError rc sqlHTypeStmt (castPtr stmt) - liftM fromIntegral (peek rcptr) - --- | Return 'True' if there are more rows, 'False' if end-of-data. -fetch :: StmtHandle -> IO Bool -fetch stmt = do - rc <- sqlFetch stmt - when (rc /= sqlRcNoData) - (checkError rc sqlHTypeStmt (castPtr stmt)) - return (rc /= sqlRcNoData) - -moreResults :: StmtHandle -> IO Bool -moreResults stmt = do - rc <- sqlMoreResults stmt - when (rc /= sqlRcNoData) - (checkError rc sqlHTypeStmt (castPtr stmt)) - return (rc /= sqlRcNoData) - - -commit :: ConnHandle -> IO () -commit conn = do - rc <- sqlEndTran sqlHTypeConn (castPtr conn) sqlTransCommit - checkError rc sqlHTypeConn (castPtr conn) - -rollback :: ConnHandle -> IO () -rollback conn = do - rc <- sqlEndTran sqlHTypeConn (castPtr conn) sqlTransRollback - checkError rc sqlHTypeConn (castPtr conn) - -setAutoCommitOn :: ConnHandle -> IO () -setAutoCommitOn conn = do - rc <- sqlSetConnectAttr conn sqlAttrAutoCommit (int2Ptr sqlAutoCommitOn) 0 - checkError rc sqlHTypeConn (castPtr conn) - -setAutoCommitOff :: ConnHandle -> IO () -setAutoCommitOff conn = do - rc <- sqlSetConnectAttr conn sqlAttrAutoCommit (int2Ptr sqlAutoCommitOff) 0 - checkError rc sqlHTypeConn (castPtr conn) - -setTxnIsolation :: ConnHandle -> SqlInteger -> IO () -setTxnIsolation conn level = do - rc <- sqlSetConnectAttr conn sqlAttrTxnIsolation (int2Ptr level) 0 - checkError rc sqlHTypeConn (castPtr conn) - - ---------------------------------------------------------------------- --- Get column values with SQLGetData - -getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b) -getMaybeFromBuffer szptr bptr action = do - len <- peek szptr - if len < 0 then return Nothing - else action bptr len >>= return . Just - -getDataStorable :: Storable a => StmtHandle -> Int -> SqlDataType -> Int -> (a -> b) -> IO (Maybe b) -getDataStorable stmt pos sqltype buffersize convert = do - allocaBytes buffersize $ \bptr -> do - alloca $ \szptr -> do - rc <- sqlGetData stmt (fromIntegral pos) sqltype (castPtr bptr) 0 szptr - checkError rc sqlHTypeStmt (castPtr stmt) - getMaybeFromBuffer szptr bptr (\buffer len -> peek buffer >>= return . convert ) - -getDataUtcTime :: StmtHandle -> Int -> IO (Maybe UTCTime) -getDataUtcTime stmt pos = do - allocaBytes #{size TIMESTAMP_STRUCT} $ \bptr -> do - alloca $ \szptr -> do - rc <- sqlGetData stmt (fromIntegral pos) sqlDTypeTimestamp (castPtr bptr) 50 szptr - checkError rc sqlHTypeStmt (castPtr stmt) - getMaybeFromBuffer szptr bptr (\buffer len -> readUtcTimeFromMemory buffer >>= return ) - -getDataCStringLen :: StmtHandle -> Int -> IO (Maybe CStringLen) -getDataCStringLen stmt pos = do - alloca $ \szptr -> do - allocaBytes 16 $ \dummyptr -> do - -- Call GetData with 0-sized buffer to get size information. - rc <- sqlGetData stmt (fromIntegral pos) sqlDTypeString (castPtr dummyptr) 0 szptr - when (rc /= sqlRcSuccessWithInfo) - (checkError rc sqlHTypeStmt (castPtr stmt)) - bufSize <- peek szptr - let bufSize' = 1 + if bufSize < 0 then 0 else bufSize - -- Use size information to allocate perfectly-sized buffer. - allocaBytes (fromIntegral bufSize') $ \bptr -> do - rc <- sqlGetData stmt (fromIntegral pos) sqlDTypeString (castPtr bptr) 100000 szptr - checkError rc sqlHTypeStmt (castPtr stmt) - len <- peek szptr - if len < 0 then return Nothing - else return (Just (castPtr bptr, fromIntegral len)) - -getDataUTF8String :: StmtHandle -> Int -> IO (Maybe String) -getDataUTF8String stmt pos = do - mbcstrlen <- getDataCStringLen stmt pos - case mbcstrlen of - Nothing -> return Nothing - Just cstrlen -> peekUTF8StringLen cstrlen >>= return . Just - -getDataCString :: StmtHandle -> Int -> IO (Maybe String) -getDataCString stmt pos = do - mbcstrlen <- getDataCStringLen stmt pos - case mbcstrlen of - Nothing -> return Nothing - Just cstrlen -> peekCStringLen cstrlen >>= return . Just - -{- from sqltypes.h. Struct size depends on size of SmallInt etc, -but is 16 bytes on a 32-bit platform. 32 bytes on 64-bit? -typedef struct tagTIMESTAMP_STRUCT { - SQLSMALLINT year; - SQLUSMALLINT month; - SQLUSMALLINT day; - SQLUSMALLINT hour; - SQLUSMALLINT minute; - SQLUSMALLINT second; - SQLUINTEGER fraction; -} TIMESTAMP_STRUCT; --} - -peekSmallInt :: Ptr a -> Int -> IO SqlSmallInt -peekSmallInt buffer offset = peekByteOff buffer offset -peekUSmallInt :: Ptr a -> Int -> IO SqlUSmallInt -peekUSmallInt buffer offset = peekByteOff buffer offset -peekUInteger :: Ptr a -> Int -> IO SqlUInteger -peekUInteger buffer offset = peekByteOff buffer offset - --- We have to give the Ptr a concrete type, to keep the type-checker --- happy, but it can be anything. It has to be a Storable type, though. - -readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime -readUtcTimeFromMemory buffer = do - year <- peekSmallInt buffer #{offset TIMESTAMP_STRUCT, year} - month <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, month} - day <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, day} - hour <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, hour} - minute <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, minute} - second <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, second} - -- Fraction ranges from 0 - 999,999,999, - frac <- peekUInteger buffer #{offset TIMESTAMP_STRUCT, fraction} - let secs :: Double; secs = fromIntegral second + (fromIntegral frac / 1000000000.0) - return (mkUTCTime (fromIntegral year) month day hour minute second) - ---------------------------------------------------------------------- --- Return-set column binding. --- Apparently this is faster than SQLGetData for larger result-sets, --- because the output buffers do not need to be rebound with --- every call. --- Dunno how much difference this'll make in practice. Suck 'n' see. - -bindColumnBuffer :: StmtHandle -> Int -> SqlDataType -> SqlLen -> IO BindBuffer -bindColumnBuffer stmt pos dtype size = do - buffer <- createEmptyBuffer (fromIntegral size) - withForeignPtr (bindBufPtr buffer) $ \bptr -> do - withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do - rc <- sqlBindCol stmt (fromIntegral pos) dtype bptr size szptr - checkError rc sqlHTypeStmt (castPtr stmt) - return buffer - -createEmptyBuffer :: SqlLen -> IO BindBuffer -createEmptyBuffer size = do - szfptr <- mallocForeignPtr - bfptr <- mallocForeignPtrBytes (fromIntegral size) - return (BindBuffer bfptr szfptr size) - - -testForNull :: BindBuffer -> (Ptr Buffer -> SqlLen -> IO a) -> IO (Maybe a) -testForNull buffer action = do - withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do - len <- peek szptr - -- sqlNullData = -1, so anthing less than zero could - -- be treated as null. - if len < 0 then return Nothing - else withForeignPtr (bindBufPtr buffer) $ \bptr -> - action bptr len >>= return . Just - -getStorableFromBuffer :: Storable a => BindBuffer -> IO (Maybe a) -getStorableFromBuffer buffer = - testForNull buffer (\bptr _ -> peek (castPtr bptr)) - -getCAStringFromBuffer :: BindBuffer -> IO (Maybe String) -getCAStringFromBuffer buffer = - testForNull buffer (\ptr len -> peekCAStringLen (castPtr ptr, fromIntegral len)) - -getCWStringFromBuffer :: BindBuffer -> IO (Maybe String) -getCWStringFromBuffer buffer = - testForNull buffer (\ptr len -> peekCWStringLen (castPtr ptr, fromIntegral len)) - -getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String) -getUTF8StringFromBuffer buffer = - testForNull buffer (\ptr len -> peekUTF8StringLen (castPtr ptr, fromIntegral len)) - -getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime) -getUtcTimeFromBuffer bindbuffer = do - testForNull bindbuffer $ \buffer _ -> do - readUtcTimeFromMemory (castPtr buffer) - - ---------------------------------------------------------------------- --- Parameter binding - -createBufferForStorable :: Storable a => Maybe a -> IO BindBuffer -createBufferForStorable Nothing = - let zero :: Int; zero = 0; in createBufferHelper zero (-1) -createBufferForStorable (Just val) = createBufferHelper val (fromIntegral (sizeOf val)) - -createBufferHelper :: Storable a => a -> SqlLen -> IO BindBuffer -createBufferHelper val size = do - szfptr <- mallocForeignPtr - withForeignPtr szfptr (\szptr -> poke szptr size) - bfptr <- mallocForeignPtr - withForeignPtr bfptr (\bptr -> poke bptr val) - return (BindBuffer (castForeignPtr bfptr) szfptr (fromIntegral size)) - -wrapSizedBuffer :: Ptr a -> SqlLen -> IO BindBuffer -wrapSizedBuffer valptr size = do - szfptr <- mallocForeignPtr - withForeignPtr szfptr (\szptr -> poke szptr size) - bfptr <- newForeignPtr finalizerFree valptr - return (BindBuffer (castForeignPtr bfptr) szfptr (fromIntegral size)) - -bindParam :: - StmtHandle - -> Int - -> SqlParamDirection - -> SqlCDataType - -> SqlDataType - -> SqlULen - -> SqlSmallInt - -> BindBuffer - -> IO () -bindParam stmt pos direction ctype sqltype precision scale buffer = - withForeignPtr (bindBufPtr buffer) $ \bptr -> do - withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do - size <- peek szptr - rc <- sqlBindParameter stmt (fromIntegral pos) direction ctype sqltype precision scale bptr size szptr - checkError rc sqlHTypeStmt (castPtr stmt) - --- sqlParamInput -bindNull :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> IO BindBuffer -bindNull stmt pos direction ctype dtype = do - let val :: Maybe Int; val = Nothing - buffer <- createBufferForStorable val - bindParam stmt pos direction ctype dtype 0 0 buffer - return buffer - -bindParamCStringLen :: StmtHandle -> Int -> SqlParamDirection -> Maybe CStringLen -> IO BindBuffer -bindParamCStringLen stmt pos direction Nothing = - bindNull stmt pos direction sqlCTypeString sqlDTypeString -bindParamCStringLen stmt pos direction (Just (cstr, clen)) = do - buffer <- wrapSizedBuffer cstr (fromIntegral clen) - bindParam stmt pos direction sqlCTypeString sqlDTypeString (fromIntegral clen) 0 buffer - return buffer - -bindEncodedString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> (String -> ((Ptr a, Int) -> IO BindBuffer) -> IO BindBuffer) -> IO BindBuffer -bindEncodedString stmt pos direction Nothing withEncoder = - bindNull stmt pos direction sqlCTypeString sqlDTypeString -bindEncodedString stmt pos direction (Just s) withEncoder = - withEncoder s (\(cs, cl) -> bindParamCStringLen stmt pos direction (Just (castPtr cs, cl))) - -bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer -bindParamUTF8String stmt pos direction val = - bindEncodedString stmt pos direction val withUTF8StringLen - -bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer -bindParamCAString stmt pos direction val = - bindEncodedString stmt pos direction val withCAStringLen - -bindParamCWString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer -bindParamCWString stmt pos direction val = - bindEncodedString stmt pos direction val withCWStringLen - -pokeSmallInt :: Ptr a -> Int -> SqlSmallInt -> IO () -pokeSmallInt buffer offset val = pokeByteOff buffer offset val -pokeUSmallInt :: Ptr a -> Int -> SqlUSmallInt -> IO () -pokeUSmallInt buffer offset val = pokeByteOff buffer offset val -pokeUInteger :: Ptr a -> Int -> SqlUInteger -> IO () -pokeUInteger buffer offset val = pokeByteOff buffer offset val - -writeUTCTimeToMemory :: Ptr Word8 -> UTCTime -> IO () -writeUTCTimeToMemory buffer utc = do - let - (LocalTime ltday time) = utcToLocalTime (hoursToTimeZone 0) utc - (TimeOfDay hour minute second) = time - (year, month, day) = toGregorian ltday - pokeSmallInt buffer #{offset TIMESTAMP_STRUCT, year} (fromIntegral year) - pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, month} (fromIntegral month) - pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, day} (fromIntegral day) - pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, hour} (fromIntegral hour) - pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, minute} (fromIntegral minute) - -- what do we do with fraction? What sort of fraction is it? - -- apparently can range from 0 - 999,999,999, - -- but MS SQL Server only handles milliseconds (0 - 999) i.e. precision 3 - let (secs, frac) = properFraction second - let fraction :: SqlUInteger; fraction = round (frac * 1000000000.0) - pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, second} secs - pokeUInteger buffer #{offset TIMESTAMP_STRUCT, fraction} fraction - --- writeUTCTimeToMemory and makeUtcTimeBuffer don't work with MS SQL Server; --- it always returns 22008 "Datetime field overflow". --- They work with PostgreSQL and Oracle ODBC drivers. --- So I'll leave the code here, in case anyone is desperate --- to marshal via TIMESTAMP_STRUCT, rather than strings. - -makeUtcTimeBuffer :: UTCTime -> IO BindBuffer -makeUtcTimeBuffer utc = do - mem <- mallocBytes #{size TIMESTAMP_STRUCT} - writeUTCTimeToMemory (castPtr mem) utc - wrapSizedBuffer mem #{size TIMESTAMP_STRUCT} - -makeUtcTimeStringBuffer :: UTCTime -> IO BindBuffer -makeUtcTimeStringBuffer utc = do - mem <- mallocBytes 40 - let s = utcTimeToOdbcDatetime utc - withCStringLen s $ \(cstr, clen) -> do - copyBytes mem cstr (fromIntegral clen) - pokeByteOff mem (fromIntegral clen) (0 :: Word8) - wrapSizedBuffer mem (fromIntegral clen) - -bindParamUtcTime :: StmtHandle -> Int -> SqlParamDirection -> Maybe UTCTime -> IO BindBuffer -bindParamUtcTime stmt pos direction Nothing = do - bindNull stmt pos direction sqlCTypeTimestamp sqlDTypeTimestamp -bindParamUtcTime stmt pos direction (Just utc) = do - -- For TimeStamp: - -- Size/Length should be 16 bytes. - -- Precision should be 8 (or 16?). - -- Scale is the number of digits in the fraction component (SQL Server only allows 0-3). - -- We're not using the TIMESTAMP_STRUCT to marshal any more. - --buffer <- makeUtcTimeBuffer utc - --bindParam stmt pos direction sqlCTypeTimestamp sqlDTypeTimestamp #{size TIMESTAMP_STRUCT} 0 buffer - -- - -- We have to pass in a String, rather than a TIMESTAMP_STRUCT, - -- and let the ODBC driver do the conversion. - -- I cannot get TIMESTAMP_STRUCT to work with MS SQL Server; - -- it always returns 22008 "Datetime field overflow". - buffer <- makeUtcTimeStringBuffer utc - withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do - size <- peek szptr - -- 23 is the largest precision value allowed by MS SQL Server. - -- That gives us "yyyy-mm-dd hh:mm:ss.fff" - bindParam stmt pos direction sqlCTypeString sqlDTypeTimestamp 23 0 buffer - return buffer - - ---------------------------------------------------------------------- --- Binding with class... - -sizeOfMaybe :: forall a. Storable a => Maybe a -> Int -sizeOfMaybe _ = sizeOf ( undefined :: a ) --- H98 stylee... ---sizeOfMaybe v@Nothing = sizeOfMaybe (asTypeOf (Just undefined) v) ---sizeOfMaybe (Just v) = sizeOf v - -newtype OutParam a = OutParam a -newtype InOutParam a = InOutParam a - -{- -Separate out the type different types of binding: parameter and column. - -Both types use the same BindBuffer, but bind parameters -can send and receive values from the buffer, whereas -column binds only receive values. -This distinction will be handled by having a set of -instances for OdbcBindBuffer that are of the form (Maybe a), -where a is one of the normal database types e.g. Int, Double, -String, UTCTime. -The instances for OdbcBindParam will include the (Maybe a) set, -and also (OutParam (Maybe a)), and (InOutParam (Maybe a)), -to indicate Out and In/Out paramaters. - -When we do a column buffer bind, we require a dummy value -of the column data type, so that we know which instance to use. --} - -class OdbcBindBuffer a where - bindColBuffer - :: StmtHandle -- ^ stmt handle - -> Int -- ^ column position (1-indexed) - -> Int -- ^ size of result buffer (ignored when it can be inferred from type of a) - -> a -- ^ dummy value of the appropriate type (just to ensure we get the right class instance) - -> IO BindBuffer -- ^ returns a 'BindBuffer' object - getFromBuffer :: BindBuffer -> IO a - getData :: StmtHandle -> Int -> IO a - -instance OdbcBindBuffer (Maybe Int) where - bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeInt (fromIntegral (sizeOfMaybe val)) - getFromBuffer buffer = getStorableFromBuffer buffer - getData stmt pos = getDataStorable stmt pos sqlDTypeInt (sizeOf cint) convert - where convert :: CInt -> Int; convert = fromIntegral - cint :: CInt; cint = 0 - -instance OdbcBindBuffer (Maybe Double) where - bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeDouble (fromIntegral (sizeOfMaybe val)) - getFromBuffer buffer = getStorableFromBuffer buffer - getData stmt pos = getDataStorable stmt pos sqlDTypeDouble (sizeOf cdbl) convert - where convert :: CDouble -> Double; convert = realToFrac - cdbl :: CDouble; cdbl = 0 - -instance OdbcBindBuffer (Maybe String) where - bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeString (fromIntegral size) - getFromBuffer buffer = getUTF8StringFromBuffer buffer - getData stmt pos = getDataUTF8String stmt pos - -instance OdbcBindBuffer (Maybe UTCTime) where - bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeTimestamp #{size TIMESTAMP_STRUCT} - getFromBuffer buffer = getUtcTimeFromBuffer buffer - getData stmt pos = getDataUtcTime stmt pos - - -class OdbcBindParam a where - bindParamBuffer - :: StmtHandle -- ^ stmt handle - -> Int -- ^ parameter position (1-indexed) - -> a -- ^ value to write to buffer - -> IO BindBuffer -- ^ returns a 'BindBuffer' object - -instance OdbcBindParam (Maybe Int) where - bindParamBuffer stmt pos val = do - buffer <- createBufferForStorable val - bindParam stmt pos sqlParamInput sqlCTypeInt sqlDTypeInt 30 0 buffer - return buffer - -instance OdbcBindParam (Maybe Double) where - bindParamBuffer stmt pos val = do - buffer <- createBufferForStorable val - bindParam stmt pos sqlParamInput sqlCTypeDouble sqlDTypeDouble 50 50 buffer - return buffer - -instance OdbcBindParam (Maybe String) where - bindParamBuffer stmt pos val = bindParamUTF8String stmt pos sqlParamInput val - -instance OdbcBindParam (Maybe UTCTime) where - bindParamBuffer stmt pos val = bindParamUtcTime stmt pos sqlParamInput val - - ---------------------------------------------------------------------- --- FFI - --- From sql.h: --- SQLRETURN SQL_API SQLAllocHandle(SQLSMALLINT,SQLHANDLE,SQLHANDLE*); -foreign import #{CALLCONV} unsafe "sql.h SQLAllocHandle" sqlAllocHandle :: - SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn - --- SQLRETURN SQL_API SQLFreeHandle(SQLSMALLINT,SQLHANDLE); -foreign import #{CALLCONV} unsafe "sql.h SQLFreeHandle" sqlFreeHandle :: - SqlSmallInt -> Handle -> IO SqlReturn - --- SQLRETURN SQL_API SQLGetDiagRec(SQLSMALLINT,SQLHANDLE,SQLSMALLINT,SQLCHAR*,SQLINTEGER*,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*); -foreign import #{CALLCONV} unsafe "sql.h SQLGetDiagRec" sqlGetDiagRec :: - SqlHandleType -- ^ enum: which handle type is the next parameter? - -> Handle -- ^ generic handle ptr - -> SqlSmallInt -- ^ row (or message) number - -> MyCString -- ^ OUT: state - -> Ptr SqlInteger -- ^ OUT: error number - -> MyCString -- ^ OUT: error message - -> SqlSmallInt -- ^ IN: message buffer size - -> Ptr SqlSmallInt -- ^ OUT: message length - -> IO SqlReturn - --- SQLRETURN SQL_API SQLDriverConnect(SQLHDBC,SQLHWND,SQLCHAR*,SQLSMALLINT,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*,SQLUSMALLINT); -foreign import #{CALLCONV} unsafe "sql.h SQLDriverConnect" sqlDriverConnect :: - ConnHandle - -> WindowHandle -- ^ just pass nullPtr - -> MyCString -- ^ connection string - -> SqlSmallInt -- ^ connection string size - -> MyCString -- ^ OUT: buffer for normalised connection string - -> SqlSmallInt -- ^ buffer size - -> Ptr SqlSmallInt -- ^ OUT: length of returned string - -> SqlUSmallInt -- ^ enum: should driver prompt user for missing info? - -> IO SqlReturn - --- SQLRETURN SQL_API SQLDisconnect(SQLHDBC); -foreign import #{CALLCONV} unsafe "sql.h SQLDisconnect" sqlDisconnect :: - ConnHandle -> IO SqlReturn - --- SQLRETURN SQL_API SQLSetEnvAttr(SQLHENV,SQLINTEGER,SQLPOINTER,SQLINTEGER); -foreign import #{CALLCONV} unsafe "sql.h SQLSetEnvAttr" sqlSetEnvAttr :: - EnvHandle -- ^ Env Handle - -> SqlInteger -- ^ Attribute (enumeration) - -> Ptr () -- ^ value (cast to void*) - -> SqlInteger -- ^ ? - set to 0 - -> IO SqlReturn - --- SQLRETURN SQL_API SQLSetConnectAttr(SQLHDBC,SQLINTEGER,SQLPOINTER,SQLINTEGER); -foreign import #{CALLCONV} unsafe "sql.h SQLSetConnectAttr" sqlSetConnectAttr :: - ConnHandle -- ^ Connection Handle - -> SqlInteger -- ^ Attribute (enumeration) - -> Ptr () -- ^ value (cast to void*) - -> SqlInteger -- ^ ? - set to 0 - -> IO SqlReturn - --- SQLRETURN SQL_API SQLPrepare(SQLHSTMT,SQLCHAR*,SQLINTEGER); -foreign import #{CALLCONV} unsafe "sql.h SQLPrepare" sqlPrepare :: - StmtHandle -> MyCString -> SqlInteger -> IO SqlReturn - --- SQLRETURN SQL_API SQLExecute(SQLHSTMT); -foreign import #{CALLCONV} unsafe "sql.h SQLExecute" sqlExecute :: - StmtHandle -> IO SqlReturn - --- SQLRETURN SQL_API SQLCloseCursor(SQLHSTMT); -foreign import #{CALLCONV} unsafe "sql.h SQLCloseCursor" sqlCloseCursor :: - StmtHandle -> IO SqlReturn - --- SQLRETURN SQL_API SQLRowCount(SQLHSTMT,SQLLEN*); -foreign import #{CALLCONV} unsafe "sql.h SQLRowCount" sqlRowCount :: - StmtHandle -> Ptr SqlLen -> IO SqlReturn - --- SQLRETURN SQL_API SQLGetData(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*); -foreign import #{CALLCONV} unsafe "sql.h SQLGetData" sqlGetData :: - StmtHandle - -> SqlUSmallInt -- ^ column position, 1-indexed - -> SqlDataType -- ^ SQL data type: string, int, long, date, etc - -> Ptr Buffer -- ^ output buffer - -> SqlLen -- ^ output buffer size - -> Ptr SqlLen -- ^ output data size, or -1 (SQL_NULL_DATA) for null - -> IO SqlReturn - --- SQLRETURN SQL_API SQLBindCol(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*); -foreign import #{CALLCONV} unsafe "sql.h SQLBindCol" sqlBindCol :: - StmtHandle - -> SqlUSmallInt -- ^ column position, 1-indexed - -> SqlDataType -- ^ SQL data type: string, int, long, date, etc - -> Ptr Buffer -- ^ output buffer - -> SqlLen -- ^ output buffer size - -> Ptr SqlLen -- ^ output data size, or -1 (SQL_NULL_DATA) for null - -> IO SqlReturn - --- SQLRETURN SQL_API SQLFetch(SQLHSTMT); -foreign import #{CALLCONV} unsafe "sql.h SQLFetch" sqlFetch :: - StmtHandle -> IO SqlReturn - --- SQLRETURN SQL_API SQLBindParameter(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLSMALLINT,SQLSMALLINT,SQLULEN,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*); -foreign import #{CALLCONV} unsafe "sql.h SQLBindParameter" sqlBindParameter :: - StmtHandle - -> SqlUSmallInt -- ^ position, 1-indexed - -> SqlParamDirection -- ^ direction: IN, OUT - -> SqlCDataType -- ^ C data type: char, int, long, float, etc - -> SqlDataType -- ^ SQL data type: string, int, long, date, etc - -> SqlULen -- ^ col size (precision) - -> SqlSmallInt -- ^ decimal digits (scale) - -> Ptr Buffer -- ^ input+output buffer - -> SqlLen -- ^ buffer size - -> Ptr SqlLen -- ^ input+output data size, or -1 (SQL_NULL_DATA) for null - -> IO SqlReturn - --- SQLRETURN SQL_API SQLMoreResults(SQLHSTMT); -foreign import #{CALLCONV} unsafe "sql.h SQLMoreResults" sqlMoreResults :: - StmtHandle -> IO SqlReturn - --- SQLRETURN SQL_API SQLEndTran(SQLSMALLINT,SQLHANDLE,SQLSMALLINT); -foreign import #{CALLCONV} unsafe "sql.h SQLEndTran" sqlEndTran :: - SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn + +{-# OPTIONS -ffi #-} +{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +#ifdef mingw32_HOST_OS +#include +#endif +#include +#include + +#ifdef mingw32_HOST_OS +#let CALLCONV = "stdcall" +#else +#let CALLCONV = "ccall" +#endif + +{- +http://msdn.microsoft.com/library/default.asp?url=/library/en-us/odbc/htm/odbcodbc_api_reference.asp +http://www.dbmaker.com.tw/reference/manuals/odbc/odbc_chap_04.html +-} + + +-- | +-- Module : Database.ODBC.OdbcFunctions +-- Copyright : (c) 2007 Oleg Kiselyov, Alistair Bayley +-- License : BSD-style +-- Maintainer : oleg@pobox.com, alistair@abayley.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Wrappers for ODBC FFI functions, plus buffer marshaling. + +module Database.ODBC.OdbcFunctions where + +import Control.Exception +import Control.Monad +import Data.Dynamic +import Data.Time +import Database.Util +import Foreign +import Foreign.C +import Foreign.C.UTF8 + +data HandleObj = HandleObj +type Handle = Ptr HandleObj +data EnvObj = EnvObj +type EnvHandle = Ptr EnvObj +data ConnObj = ConnObj +type ConnHandle = Ptr ConnObj +data StmtObj = StmtObj +type StmtHandle = Ptr StmtObj +type WindowHandle = Ptr () +data Buffer = Buffer +type BufferFPtr = ForeignPtr Buffer +type SizeFPtr = ForeignPtr SqlLen + +data BindBuffer = BindBuffer + { bindBufPtr :: BufferFPtr + , bindBufSzPtr :: SizeFPtr + , bindBufSize :: SqlLen + } + +type SqlInteger = #{type SQLINTEGER} +type SqlUInteger = #{type SQLUINTEGER} +type SqlSmallInt = #{type SQLSMALLINT} +type SqlUSmallInt = #{type SQLUSMALLINT} +type SqlLen = #{type SQLLEN} +type SqlULen = #{type SQLULEN} +type SqlReturn = SqlSmallInt +type SqlHandleType = SqlSmallInt +type SqlDataType = SqlSmallInt +type SqlCDataType = SqlSmallInt +type SqlParamDirection = SqlSmallInt + +-- Return codes from API calls + +( + sqlRcInvalidHandle : + sqlRcStillExecuting : + sqlRcSuccess : + sqlRcSuccessWithInfo : + sqlRcError : + sqlRcNeedData : + sqlRcNoData : +-- []) = [-2,-1,0,1,2,99,100] :: [SqlReturn] + []) = + ( + #{const SQL_INVALID_HANDLE} : + #{const SQL_STILL_EXECUTING} : + #{const SQL_SUCCESS} : + #{const SQL_SUCCESS_WITH_INFO} : + #{const SQL_ERROR} : + #{const SQL_NEED_DATA} : + #{const SQL_NO_DATA} : + []) :: [SqlReturn] + +showReturnCode rc + | rc == #{const SQL_INVALID_HANDLE} = "SQL_INVALID_HANDLE" + | rc == #{const SQL_STILL_EXECUTING} = "SQL_STILL_EXECUTING" + | rc == #{const SQL_SUCCESS} = "SQL_SUCCESS" + | rc == #{const SQL_SUCCESS_WITH_INFO} = "SQL_SUCCESS_WITH_INFO" + | rc == #{const SQL_ERROR} = "SQL_ERROR" + | rc == #{const SQL_NEED_DATA} = "SQL_NEED_DATA" + | rc == #{const SQL_NO_DATA} = "SQL_NO_DATA" + | otherwise = "UNKNOWN_RETURN_CODE" + +-- There are only four handle types in ODBC. + +( + sqlHTypeEnv : + sqlHTypeConn : + sqlHTypeStmt : + sqlHTypeDesc : +-- []) = [1..4] :: [SqlHandleType] + []) = + ( + #{const SQL_HANDLE_ENV} : + #{const SQL_HANDLE_DBC} : + #{const SQL_HANDLE_STMT} : + #{const SQL_HANDLE_DESC} : + []) :: [SqlHandleType] + +sqlDriverNoPrompt :: SqlUSmallInt +sqlDriverNoPrompt = #{const SQL_DRIVER_NOPROMPT} + +sqlNullTermedString :: SqlInteger +sqlNullTermedString = #{const SQL_NTS} + +sqlNullData :: SqlLen +sqlNullData = #{const SQL_NULL_DATA} + +sqlTransCommit :: SqlSmallInt +sqlTransCommit = #{const SQL_COMMIT} + +sqlTransRollback :: SqlSmallInt +sqlTransRollback = #{const SQL_ROLLBACK} + +sqlAutoCommitOn, sqlAutoCommitOff :: SqlInteger +sqlAutoCommitOn = #{const SQL_AUTOCOMMIT_ON} +sqlAutoCommitOff = #{const SQL_AUTOCOMMIT_OFF} + +-- These are attribute types, which are passed as the second parameter +-- to sqlSetEnvAttr. + +( + sqlAttrOdbcVersion : + sqlAttrAutoCommit : + sqlAttrTxnIsolation : + []) = + ( + #{const SQL_ATTR_ODBC_VERSION} : + #{const SQL_ATTR_AUTOCOMMIT} : + #{const SQL_ATTR_TXN_ISOLATION} : + []) :: [SqlInteger] + +-- These are attribute values, which are passed as the third parameter +-- to sqlSetEnvAttr. Obviously that must accompany the relevant +-- attribute type. + +( + sqlOvOdbc3 : + sqlTxnCapable : + sqlDefaultTxnIsolation : + sqlTxnIsolationOption : + sqlTxnReadUncommitted : + sqlTxnReadCommitted : + sqlTxnRepeatableRead : + sqlTxnSerializable : + []) = + ( + #{const SQL_OV_ODBC3} : -- 3 (UL) + #{const SQL_TXN_CAPABLE} : -- 46 + #{const SQL_DEFAULT_TXN_ISOLATION} : -- 26 + #{const SQL_TXN_ISOLATION_OPTION} : -- 72 + #{const SQL_TXN_READ_UNCOMMITTED} : -- 1 + #{const SQL_TXN_READ_COMMITTED} : -- 2 + #{const SQL_TXN_REPEATABLE_READ} : -- 4 + #{const SQL_TXN_SERIALIZABLE} : -- 8 + []) :: [SqlInteger] + + +-- ODBC SQL data types +( + sqlDTypeString : + sqlDTypeInt : + sqlDTypeBinary : + sqlDTypeDouble : + sqlDTypeDate : + sqlDTypeTime : + sqlDTypeTimestamp : + sqlDTypeCursor : + []) = + ( + #{const SQL_CHAR} : -- 1 + #{const SQL_INTEGER} : -- 4 + #{const SQL_BINARY} : -- -2 + #{const SQL_DOUBLE} : -- 8 + #{const SQL_TYPE_DATE} : -- 9 + #{const SQL_TYPE_TIME} : -- 10 + #{const SQL_TYPE_TIMESTAMP} : -- 11 + #{const SQL_CURSOR_TYPE} : -- 6 + []) :: [SqlDataType] + +-- host language (C) data types + +( + sqlCTypeString : + sqlCTypeInt : + sqlCTypeBinary : + sqlCTypeDouble : + sqlCTypeDate : + sqlCTypeTime : + sqlCTypeTimestamp : + []) = + ( + #{const SQL_C_CHAR} : + #{const SQL_C_LONG} : + #{const SQL_C_BINARY} : + #{const SQL_C_DOUBLE} : + #{const SQL_C_TYPE_DATE} : + #{const SQL_C_TYPE_TIME} : + #{const SQL_C_TYPE_TIMESTAMP} : + []) :: [SqlCDataType] + +{- +#define SQL_C_BINARY SQL_BINARY +#define SQL_C_BIT SQL_BIT +#define SQL_C_BOOKMARK SQL_C_ULONG +#define SQL_C_CHAR SQL_CHAR +#define SQL_C_DATE SQL_DATE +#define SQL_C_DEFAULT 99 +#define SQL_C_DOUBLE SQL_DOUBLE +#define SQL_C_FLOAT SQL_REAL +#define SQL_C_LONG SQL_INTEGER +#define SQL_C_SHORT SQL_SMALLINT +#define SQL_C_SLONG (SQL_C_LONG+SQL_SIGNED_OFFSET) +#define SQL_C_SSHORT (SQL_C_SHORT+SQL_SIGNED_OFFSET) +#define SQL_C_STINYINT (SQL_TINYINT+SQL_SIGNED_OFFSET) +#define SQL_C_TIME SQL_TIME +#define SQL_C_TIMESTAMP SQL_TIMESTAMP +#define SQL_C_TINYINT SQL_TINYINT +#define SQL_C_ULONG (SQL_C_LONG+SQL_UNSIGNED_OFFSET) +#define SQL_C_USHORT (SQL_C_SHORT+SQL_UNSIGNED_OFFSET) +#define SQL_C_UTINYINT (SQL_TINYINT+SQL_UNSIGNED_OFFSET) +-} + +( + sqlParamInput : + sqlParamInputOutput : + sqlParamOutput : + sqlParamDefault : + sqlParamUnknown : + [] ) = + ( + #{const SQL_PARAM_INPUT} : + #{const SQL_PARAM_INPUT_OUTPUT} : + #{const SQL_PARAM_OUTPUT} : + #{const SQL_PARAM_TYPE_DEFAULT} : + #{const SQL_PARAM_TYPE_UNKNOWN} : + [] ) :: [SqlParamDirection] + + +data OdbcException = OdbcException Int String String [OdbcException] + deriving (Typeable) + +instance Show OdbcException where + show (OdbcException i st s more) = "OdbcException " + ++ (show i) ++ " " ++ st ++ " " ++ s -- ++ (concat (map showOdbcExMsg more)) + +-- showOdbcExMsg (OdbcException i st s more) = s + +catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a +catchOdbc = catchDyn + +throwOdbc :: OdbcException -> a +throwOdbc = throwDyn + +-- define SQL_SUCCEEDED(rc) (((rc)&(~1))==0) +sqlSucceeded rc = rc == sqlRcSuccess || rc == sqlRcSuccessWithInfo + +type MyCString = CString +type MyCStringLen = CStringLen +myPeekCStringLen p = peekUTF8StringLen p +myWithCString s = withUTF8String s +myWithCStringLen s = withUTF8StringLen s +--myPeekCStringLen p = peekCStringLen p +--myWithCString s = withCString s +--myWithCStringLen s = withCStringLen s + +getDiagRec :: SqlReturn -> SqlHandleType -> Handle -> SqlSmallInt -> IO [OdbcException] +getDiagRec retcode htype handle row = + allocaBytes 6 $ \cstrState -> do + alloca $ \errorNumPtr -> do + allocaBytes 1025 $ \cstrMsg -> do + alloca $ \msgLenPtr -> do + rc <- sqlGetDiagRec htype handle row cstrState errorNumPtr cstrMsg 1024 msgLenPtr + --putStrLn ("getDiagRec: rc=" ++ show rc) + case () of + _ | rc == sqlRcSuccess -> do + errnum <- peek errorNumPtr + state <- myPeekCStringLen (cstrState, 5) + msglen <- peek msgLenPtr + --putStrLn ("getDiagRec: msglen=" ++ show msglen) + msg <- myPeekCStringLen (cstrMsg, fromIntegral msglen) + --putStrLn ("getDiagRec: msg=" ++ msg) + more <- getDiagRec retcode htype handle (row+1) + return ((OdbcException (fromIntegral errnum) state msg []) : more) + | rc == sqlRcNoData -> return [] + | otherwise -> return [OdbcException (fromIntegral rc) "01000" (showReturnCode retcode) []] + +checkError :: SqlReturn -> SqlHandleType -> Handle -> IO () +checkError rc htype handle = + when (rc /= sqlRcSuccess && rc /= sqlRcSuccessWithInfo) + (do + exs <- getDiagRec rc htype handle 1 + if null exs + then throwOdbc (OdbcException (fromIntegral rc) "01000" + ("No error messages for return code " ++ show rc ++ " (" ++ showReturnCode rc ++ ")") []) + else do + let (OdbcException i st s _) = head exs + throwOdbc (OdbcException i st s (tail exs)) + ) + +allocHdl :: (Storable a) => Handle -> SqlHandleType -> IO a +allocHdl h htype = do + alloca $ \hptr -> do + rc <- sqlAllocHandle htype h (castPtr hptr) + checkError rc htype h + peek hptr + +allocEnv :: IO EnvHandle +allocEnv = allocHdl nullPtr sqlHTypeEnv + +allocConn :: EnvHandle -> IO ConnHandle +allocConn env = allocHdl (castPtr env) sqlHTypeConn + +allocStmt :: ConnHandle -> IO StmtHandle +allocStmt conn = allocHdl (castPtr conn) sqlHTypeStmt + +freeHelper :: SqlHandleType -> Handle -> IO () +freeHelper htype h = do + rc <- sqlFreeHandle htype h + checkError rc htype h + +freeEnv :: EnvHandle -> IO () +freeEnv env = freeHelper sqlHTypeEnv (castPtr env) + +freeConn :: ConnHandle -> IO () +freeConn conn = freeHelper sqlHTypeConn (castPtr conn) + +freeStmt :: StmtHandle -> IO () +freeStmt stmt = freeHelper sqlHTypeStmt (castPtr stmt) + +int2Ptr :: SqlInteger -> Ptr () +int2Ptr i = plusPtr nullPtr (fromIntegral i) + +setOdbcVer :: EnvHandle -> IO () +setOdbcVer env = do + rc <- sqlSetEnvAttr env sqlAttrOdbcVersion (int2Ptr sqlOvOdbc3) 0 + checkError rc sqlHTypeEnv (castPtr env) + +connect :: ConnHandle -> String -> IO String +connect conn connstr = do + myWithCStringLen connstr $ \(cstr, clen) -> do + allocaBytes 1000 $ \outConnStr -> do + alloca $ \ptrOutLen -> do + rc <- sqlDriverConnect conn nullPtr cstr (fromIntegral clen) + outConnStr 1000 ptrOutLen sqlDriverNoPrompt + checkError rc sqlHTypeConn (castPtr conn) + outLen <- peek ptrOutLen + myPeekCStringLen (outConnStr, fromIntegral outLen) + +disconnect :: ConnHandle -> IO () +disconnect conn = do + rc <- sqlDisconnect conn + checkError rc sqlHTypeConn (castPtr conn) + + +prepareStmt :: StmtHandle -> String -> IO () +prepareStmt stmt sqltext = do + myWithCString sqltext $ \cstr -> do + rc <- sqlPrepare stmt cstr sqlNullTermedString + checkError rc sqlHTypeStmt (castPtr stmt) + +executeStmt :: StmtHandle -> IO () +executeStmt stmt = do + rc <- sqlExecute stmt + checkError rc sqlHTypeStmt (castPtr stmt) + +closeCursor :: StmtHandle -> IO () +closeCursor stmt = do + rc <- sqlCloseCursor stmt + checkError rc sqlHTypeStmt (castPtr stmt) + +rowCount :: StmtHandle -> IO Int +rowCount stmt = do + alloca $ \rcptr -> do + rc <- sqlRowCount stmt rcptr + checkError rc sqlHTypeStmt (castPtr stmt) + liftM fromIntegral (peek rcptr) + +-- | Return 'True' if there are more rows, 'False' if end-of-data. +fetch :: StmtHandle -> IO Bool +fetch stmt = do + rc <- sqlFetch stmt + when (rc /= sqlRcNoData) + (checkError rc sqlHTypeStmt (castPtr stmt)) + return (rc /= sqlRcNoData) + +moreResults :: StmtHandle -> IO Bool +moreResults stmt = do + rc <- sqlMoreResults stmt + when (rc /= sqlRcNoData) + (checkError rc sqlHTypeStmt (castPtr stmt)) + return (rc /= sqlRcNoData) + + +commit :: ConnHandle -> IO () +commit conn = do + rc <- sqlEndTran sqlHTypeConn (castPtr conn) sqlTransCommit + checkError rc sqlHTypeConn (castPtr conn) + +rollback :: ConnHandle -> IO () +rollback conn = do + rc <- sqlEndTran sqlHTypeConn (castPtr conn) sqlTransRollback + checkError rc sqlHTypeConn (castPtr conn) + +setAutoCommitOn :: ConnHandle -> IO () +setAutoCommitOn conn = do + rc <- sqlSetConnectAttr conn sqlAttrAutoCommit (int2Ptr sqlAutoCommitOn) 0 + checkError rc sqlHTypeConn (castPtr conn) + +setAutoCommitOff :: ConnHandle -> IO () +setAutoCommitOff conn = do + rc <- sqlSetConnectAttr conn sqlAttrAutoCommit (int2Ptr sqlAutoCommitOff) 0 + checkError rc sqlHTypeConn (castPtr conn) + +setTxnIsolation :: ConnHandle -> SqlInteger -> IO () +setTxnIsolation conn level = do + rc <- sqlSetConnectAttr conn sqlAttrTxnIsolation (int2Ptr level) 0 + checkError rc sqlHTypeConn (castPtr conn) + + +--------------------------------------------------------------------- +-- Get column values with SQLGetData. +-- These functions will probably not be used much, +-- but we'll keep them in because the ODBC API has them +-- (i.e. for completeness). +-- The OdbcBindBuffer class has a getData function which uses these, +-- if you'd rather. + +getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b) +getMaybeFromBuffer szptr bptr action = do + len <- peek szptr + if len < 0 then return Nothing + else action bptr len >>= return . Just + +getDataStorable :: Storable a => StmtHandle -> Int -> SqlDataType -> Int -> (a -> b) -> IO (Maybe b) +getDataStorable stmt pos sqltype buffersize convert = do + allocaBytes buffersize $ \bptr -> do + alloca $ \szptr -> do + rc <- sqlGetData stmt (fromIntegral pos) sqltype (castPtr bptr) 0 szptr + checkError rc sqlHTypeStmt (castPtr stmt) + getMaybeFromBuffer szptr bptr (\buffer len -> peek buffer >>= return . convert ) + +getDataUtcTime :: StmtHandle -> Int -> IO (Maybe UTCTime) +getDataUtcTime stmt pos = do + allocaBytes #{size TIMESTAMP_STRUCT} $ \bptr -> do + alloca $ \szptr -> do + rc <- sqlGetData stmt (fromIntegral pos) sqlDTypeTimestamp (castPtr bptr) 50 szptr + checkError rc sqlHTypeStmt (castPtr stmt) + getMaybeFromBuffer szptr bptr (\buffer len -> readUtcTimeFromMemory buffer >>= return ) + +getDataCStringLen :: StmtHandle -> Int -> IO (Maybe CStringLen) +getDataCStringLen stmt pos = do + alloca $ \szptr -> do + allocaBytes 16 $ \dummyptr -> do + -- Call GetData with 0-sized buffer to get size information. + rc <- sqlGetData stmt (fromIntegral pos) sqlDTypeString (castPtr dummyptr) 0 szptr + when (rc /= sqlRcSuccessWithInfo) + (checkError rc sqlHTypeStmt (castPtr stmt)) + bufSize <- peek szptr + let bufSize' = 1 + if bufSize < 0 then 0 else bufSize + -- Use size information to allocate perfectly-sized buffer. + allocaBytes (fromIntegral bufSize') $ \bptr -> do + rc <- sqlGetData stmt (fromIntegral pos) sqlDTypeString (castPtr bptr) bufSize' szptr + checkError rc sqlHTypeStmt (castPtr stmt) + len <- peek szptr + if len < 0 then return Nothing + else return (Just (castPtr bptr, fromIntegral len)) + +getDataUTF8String :: StmtHandle -> Int -> IO (Maybe String) +getDataUTF8String stmt pos = do + mbcstrlen <- getDataCStringLen stmt pos + case mbcstrlen of + Nothing -> return Nothing + Just cstrlen -> peekUTF8StringLen cstrlen >>= return . Just + +getDataCString :: StmtHandle -> Int -> IO (Maybe String) +getDataCString stmt pos = do + mbcstrlen <- getDataCStringLen stmt pos + case mbcstrlen of + Nothing -> return Nothing + Just cstrlen -> peekCStringLen cstrlen >>= return . Just + +{- from sqltypes.h. Struct size depends on size of SmallInt etc, +but is 16 bytes on a 32-bit platform. 32 bytes on 64-bit? +typedef struct tagTIMESTAMP_STRUCT { + SQLSMALLINT year; + SQLUSMALLINT month; + SQLUSMALLINT day; + SQLUSMALLINT hour; + SQLUSMALLINT minute; + SQLUSMALLINT second; + SQLUINTEGER fraction; +} TIMESTAMP_STRUCT; +-} + +peekSmallInt :: Ptr a -> Int -> IO SqlSmallInt +peekSmallInt buffer offset = peekByteOff buffer offset +peekUSmallInt :: Ptr a -> Int -> IO SqlUSmallInt +peekUSmallInt buffer offset = peekByteOff buffer offset +peekUInteger :: Ptr a -> Int -> IO SqlUInteger +peekUInteger buffer offset = peekByteOff buffer offset + +-- We have to give the Ptr a concrete type, to keep the type-checker +-- happy, but it can be anything. It has to be a Storable type, though. + +readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime +readUtcTimeFromMemory buffer = do + year <- peekSmallInt buffer #{offset TIMESTAMP_STRUCT, year} + month <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, month} + day <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, day} + hour <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, hour} + minute <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, minute} + second <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, second} + -- Fraction ranges from 0 - 999,999,999, + frac <- peekUInteger buffer #{offset TIMESTAMP_STRUCT, fraction} + let secs :: Double; secs = fromIntegral second + (fromIntegral frac / 1000000000.0) + return (mkUTCTime (fromIntegral year) month day hour minute second) + +--------------------------------------------------------------------- +-- Return-set column binding. +-- Apparently this is faster than SQLGetData for larger result-sets, +-- because the output buffers do not need to be rebound with +-- every call. +-- Dunno how much difference this'll make in practice. Suck 'n' see. + +bindColumnBuffer :: StmtHandle -> Int -> SqlDataType -> SqlLen -> IO BindBuffer +bindColumnBuffer stmt pos dtype size = do + alloca $ \colPtr -> do + rc <- sqlNumResultCols stmt colPtr + checkError rc sqlHTypeStmt (castPtr stmt) + nc <- peek colPtr + if (fromIntegral nc) < pos || pos < 1 + then throwOdbc (OdbcException (-1) "01000" + ("Attempted fetch from invalid column number " ++ show pos) []) + else do + buffer <- createEmptyBuffer (fromIntegral size) + withForeignPtr (bindBufPtr buffer) $ \bptr -> do + withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do + rc <- sqlBindCol stmt (fromIntegral pos) dtype bptr size szptr + checkError rc sqlHTypeStmt (castPtr stmt) + return buffer + +createEmptyBuffer :: SqlLen -> IO BindBuffer +createEmptyBuffer size = do + szfptr <- mallocForeignPtr + bfptr <- mallocForeignPtrBytes (fromIntegral size) + return (BindBuffer bfptr szfptr size) + + +testForNull :: BindBuffer -> (Ptr Buffer -> SqlLen -> IO a) -> IO (Maybe a) +testForNull buffer action = do + withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do + len <- peek szptr + -- sqlNullData = -1, so anthing less than zero could + -- be treated as null. + if len < 0 then return Nothing + else withForeignPtr (bindBufPtr buffer) $ \bptr -> + action bptr len >>= return . Just + +getStorableFromBuffer :: Storable a => BindBuffer -> IO (Maybe a) +getStorableFromBuffer buffer = + testForNull buffer (\bptr _ -> peek (castPtr bptr)) + +getCAStringFromBuffer :: BindBuffer -> IO (Maybe String) +getCAStringFromBuffer buffer = + testForNull buffer (\ptr len -> peekCAStringLen (castPtr ptr, fromIntegral len)) + +getCWStringFromBuffer :: BindBuffer -> IO (Maybe String) +getCWStringFromBuffer buffer = + testForNull buffer (\ptr len -> peekCWStringLen (castPtr ptr, fromIntegral len)) + +getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String) +getUTF8StringFromBuffer buffer = + testForNull buffer (\ptr len -> peekUTF8StringLen (castPtr ptr, fromIntegral len)) + +getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime) +getUtcTimeFromBuffer bindbuffer = do + testForNull bindbuffer $ \buffer _ -> do + readUtcTimeFromMemory (castPtr buffer) + + +--------------------------------------------------------------------- +-- Parameter binding + +createBufferForStorable :: Storable a => Maybe a -> IO BindBuffer +createBufferForStorable Nothing = + let zero :: Int; zero = 0; in createBufferHelper zero (-1) +createBufferForStorable (Just val) = createBufferHelper val (fromIntegral (sizeOf val)) + +createBufferHelper :: Storable a => a -> SqlLen -> IO BindBuffer +createBufferHelper val size = do + szfptr <- mallocForeignPtr + withForeignPtr szfptr (\szptr -> poke szptr size) + bfptr <- mallocForeignPtr + withForeignPtr bfptr (\bptr -> poke bptr val) + return (BindBuffer (castForeignPtr bfptr) szfptr (fromIntegral size)) + +wrapSizedBuffer :: Ptr a -> SqlLen -> IO BindBuffer +wrapSizedBuffer valptr size = do + szfptr <- mallocForeignPtr + withForeignPtr szfptr (\szptr -> poke szptr size) + bfptr <- newForeignPtr finalizerFree valptr + return (BindBuffer (castForeignPtr bfptr) szfptr (fromIntegral size)) + +bindParam :: + StmtHandle + -> Int + -> SqlParamDirection + -> SqlCDataType + -> SqlDataType + -> SqlULen + -> SqlSmallInt + -> BindBuffer + -> IO () +bindParam stmt pos direction ctype sqltype precision scale buffer = + withForeignPtr (bindBufPtr buffer) $ \bptr -> do + withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do + size <- peek szptr + rc <- sqlBindParameter stmt (fromIntegral pos) direction ctype sqltype precision scale bptr size szptr + checkError rc sqlHTypeStmt (castPtr stmt) + +bindNull :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> IO BindBuffer +bindNull stmt pos direction ctype dtype = do + let val :: Maybe Int; val = Nothing + buffer <- createBufferForStorable val + bindParam stmt pos direction ctype dtype 0 0 buffer + return buffer + +bindParamCStringLen :: StmtHandle -> Int -> SqlParamDirection -> Maybe CStringLen -> IO BindBuffer +bindParamCStringLen stmt pos direction Nothing = + bindNull stmt pos direction sqlCTypeString sqlDTypeString +bindParamCStringLen stmt pos direction (Just (cstr, clen)) = do + buffer <- wrapSizedBuffer cstr (fromIntegral clen) + bindParam stmt pos direction sqlCTypeString sqlDTypeString (fromIntegral clen) 0 buffer + return buffer + +bindEncodedString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> (String -> ((Ptr a, Int) -> IO BindBuffer) -> IO BindBuffer) -> IO BindBuffer +bindEncodedString stmt pos direction Nothing withEncoder = + bindNull stmt pos direction sqlCTypeString sqlDTypeString +bindEncodedString stmt pos direction (Just s) withEncoder = + withEncoder s (\(cs, cl) -> bindParamCStringLen stmt pos direction (Just (castPtr cs, cl))) + +bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer +bindParamUTF8String stmt pos direction val = + bindEncodedString stmt pos direction val withUTF8StringLen + +bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer +bindParamCAString stmt pos direction val = + bindEncodedString stmt pos direction val withCAStringLen + +bindParamCWString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer +bindParamCWString stmt pos direction val = + bindEncodedString stmt pos direction val withCWStringLen + +pokeSmallInt :: Ptr a -> Int -> SqlSmallInt -> IO () +pokeSmallInt buffer offset val = pokeByteOff buffer offset val +pokeUSmallInt :: Ptr a -> Int -> SqlUSmallInt -> IO () +pokeUSmallInt buffer offset val = pokeByteOff buffer offset val +pokeUInteger :: Ptr a -> Int -> SqlUInteger -> IO () +pokeUInteger buffer offset val = pokeByteOff buffer offset val + +writeUTCTimeToMemory :: Ptr Word8 -> UTCTime -> IO () +writeUTCTimeToMemory buffer utc = do + let + (LocalTime ltday time) = utcToLocalTime (hoursToTimeZone 0) utc + (TimeOfDay hour minute second) = time + (year, month, day) = toGregorian ltday + pokeSmallInt buffer #{offset TIMESTAMP_STRUCT, year} (fromIntegral year) + pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, month} (fromIntegral month) + pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, day} (fromIntegral day) + pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, hour} (fromIntegral hour) + pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, minute} (fromIntegral minute) + -- what do we do with fraction? What sort of fraction is it? + -- apparently can range from 0 - 999,999,999, + -- but MS SQL Server only handles milliseconds (0 - 999) i.e. precision 3 + let (secs, frac) = properFraction second + let fraction :: SqlUInteger; fraction = round (frac * 1000000000.0) + pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, second} secs + pokeUInteger buffer #{offset TIMESTAMP_STRUCT, fraction} fraction + +-- writeUTCTimeToMemory and makeUtcTimeBuffer don't work with MS SQL Server; +-- it always returns 22008 "Datetime field overflow". +-- They work with PostgreSQL and Oracle ODBC drivers. +-- So I'll leave the code here, in case anyone is desperate +-- to marshal via TIMESTAMP_STRUCT, rather than strings. + +xmakeUtcTimeBuffer :: UTCTime -> IO BindBuffer +xmakeUtcTimeBuffer utc = do + mem <- mallocBytes #{size TIMESTAMP_STRUCT} + writeUTCTimeToMemory (castPtr mem) utc + wrapSizedBuffer mem #{size TIMESTAMP_STRUCT} + +-- FIXME why don't we use createBufferHelper here? +-- Is it because we want to give the size of the value, +-- instead of the total buffer size? +makeUtcTimeStringBuffer :: UTCTime -> IO BindBuffer +makeUtcTimeStringBuffer utc = do + mem <- mallocBytes 50 + let s = utcTimeToOdbcDatetime utc + withCStringLen s $ \(cstr, clen) -> do + copyBytes mem cstr (fromIntegral clen) + pokeByteOff mem (fromIntegral clen) (0 :: Word8) + wrapSizedBuffer mem (fromIntegral clen) + +bindParamUtcTime :: StmtHandle -> Int -> SqlParamDirection -> Maybe UTCTime -> IO BindBuffer +bindParamUtcTime stmt pos direction Nothing = do + bindNull stmt pos direction sqlCTypeTimestamp sqlDTypeTimestamp +bindParamUtcTime stmt pos direction (Just utc) = do + -- For TimeStamp: + -- Size/Length should be 16 bytes. + -- Precision should be 8 (or 16?). + -- Scale is the number of digits in the fraction component (SQL Server only allows 0-3). + -- We're not using the TIMESTAMP_STRUCT to marshal any more. + --buffer <- makeUtcTimeBuffer utc + --bindParam stmt pos direction sqlCTypeTimestamp sqlDTypeTimestamp #{size TIMESTAMP_STRUCT} 0 buffer + -- + -- We have to pass in a String, rather than a TIMESTAMP_STRUCT, + -- and let the ODBC driver do the conversion. + -- I cannot get TIMESTAMP_STRUCT to work with MS SQL Server; + -- it always returns 22008 "Datetime field overflow". + buffer <- makeUtcTimeStringBuffer utc + withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do + size <- peek szptr + -- 23 is the largest precision value allowed by MS SQL Server. + -- That gives us "yyyy-mm-dd hh:mm:ss.fff" + bindParam stmt pos direction sqlCTypeString sqlDTypeTimestamp 23 0 buffer + return buffer + + +--------------------------------------------------------------------- +-- Binding with class... + +sizeOfMaybe :: forall a. Storable a => Maybe a -> Int +sizeOfMaybe _ = sizeOf ( undefined :: a ) +-- H98 stylee... +--sizeOfMaybe v@Nothing = sizeOfMaybe (asTypeOf (Just undefined) v) +--sizeOfMaybe (Just v) = sizeOf v + +newtype OutParam a = OutParam a +newtype InOutParam a = InOutParam a + +{- +Separate out the type different types of binding: parameter and column. + +Both types use the same BindBuffer, but bind parameters +can send and receive values from the buffer, whereas +column binds only receive values. + +So we have class OdbcBindBuffer for result set column binds +(data coming out only), and class OdbcBindParam for bind +patrameters that can be both input and output. + +We'll have instances for OdbcBindBuffer that are of the form (Maybe a), +where a is one of the normal database types e.g. Int, Double, +String, UTCTime. + +The instances for OdbcBindParam will include the (Maybe a) set, +and also (OutParam (Maybe a)), and (InOutParam (Maybe a)), +to indicate Out and In/Out paramaters. + +When we do a column buffer bind, we require a dummy value +of the column data type, so that we know which instance to use. +-} + +class OdbcBindBuffer a where + bindColBuffer + :: StmtHandle -- ^ stmt handle + -> Int -- ^ column position (1-indexed) + -> Int -- ^ size of result buffer (ignored when it can be inferred from type of a) + -> a -- ^ dummy value of the appropriate type (just to ensure we get the right class instance) + -> IO BindBuffer -- ^ returns a 'BindBuffer' object + getFromBuffer :: BindBuffer -> IO a + getData :: StmtHandle -> Int -> IO a + +instance OdbcBindBuffer (Maybe Int) where + bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeInt (fromIntegral (sizeOfMaybe val)) + getFromBuffer buffer = getStorableFromBuffer buffer + getData stmt pos = getDataStorable stmt pos sqlDTypeInt (sizeOf cint) convert + where convert :: CInt -> Int; convert = fromIntegral + cint :: CInt; cint = 0 + +instance OdbcBindBuffer (Maybe Double) where + bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeDouble (fromIntegral (sizeOfMaybe val)) + getFromBuffer buffer = getStorableFromBuffer buffer + getData stmt pos = getDataStorable stmt pos sqlDTypeDouble (sizeOf cdbl) convert + where convert :: CDouble -> Double; convert = realToFrac + cdbl :: CDouble; cdbl = 0 + +instance OdbcBindBuffer (Maybe String) where + bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeString (fromIntegral size) + getFromBuffer buffer = getUTF8StringFromBuffer buffer + getData stmt pos = getDataUTF8String stmt pos + +instance OdbcBindBuffer (Maybe UTCTime) where + --bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeTimestamp #{size TIMESTAMP_STRUCT} + bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeTimestamp 50 + getFromBuffer buffer = getUtcTimeFromBuffer buffer + getData stmt pos = getDataUtcTime stmt pos + + +class OdbcBindParam a where + bindParamBuffer + :: StmtHandle -- ^ stmt handle + -> Int -- ^ parameter position (1-indexed) + -> a -- ^ value to write to buffer + -> IO BindBuffer -- ^ returns a 'BindBuffer' object + +bindParamStorable stmt pos val dir ctype dtype precn scale = do + buffer <- createBufferForStorable val + bindParam stmt pos dir ctype dtype precn scale buffer + return buffer + +instance OdbcBindParam (Maybe Int) where + bindParamBuffer stmt pos val = + bindParamStorable stmt pos val sqlParamInput sqlCTypeInt sqlDTypeInt 30 0 + +instance OdbcBindParam (OutParam (Maybe Int)) where + bindParamBuffer stmt pos (OutParam val) = + bindParamStorable stmt pos val sqlParamOutput sqlCTypeInt sqlDTypeInt 30 0 + +instance OdbcBindParam (InOutParam (Maybe Int)) where + bindParamBuffer stmt pos (InOutParam val) = + bindParamStorable stmt pos val sqlParamInputOutput sqlCTypeInt sqlDTypeInt 30 0 + +instance OdbcBindParam (Maybe Double) where + bindParamBuffer stmt pos val = + bindParamStorable stmt pos val sqlParamInput sqlCTypeDouble sqlDTypeDouble 50 50 + +instance OdbcBindParam (OutParam (Maybe Double)) where + bindParamBuffer stmt pos (OutParam val) = + bindParamStorable stmt pos val sqlParamOutput sqlCTypeDouble sqlDTypeDouble 50 50 + +instance OdbcBindParam (InOutParam (Maybe Double)) where + bindParamBuffer stmt pos (InOutParam val) = + bindParamStorable stmt pos val sqlParamInputOutput sqlCTypeDouble sqlDTypeDouble 50 50 + +instance OdbcBindParam (Maybe String) where + bindParamBuffer stmt pos val = + bindParamUTF8String stmt pos sqlParamInput val + +instance OdbcBindParam (OutParam (Maybe String)) where + bindParamBuffer stmt pos (OutParam val) = + bindParamUTF8String stmt pos sqlParamOutput val + +instance OdbcBindParam (InOutParam (Maybe String)) where + bindParamBuffer stmt pos (InOutParam val) = + bindParamUTF8String stmt pos sqlParamInputOutput val + +instance OdbcBindParam (Maybe UTCTime) where + bindParamBuffer stmt pos val = + bindParamUtcTime stmt pos sqlParamInput val + +instance OdbcBindParam (OutParam (Maybe UTCTime)) where + bindParamBuffer stmt pos (OutParam val) = + bindParamUtcTime stmt pos sqlParamOutput val + +instance OdbcBindParam (InOutParam (Maybe UTCTime)) where + bindParamBuffer stmt pos (InOutParam val) = + bindParamUtcTime stmt pos sqlParamInputOutput val + + +--------------------------------------------------------------------- +-- FFI + +-- From sql.h: +-- SQLRETURN SQL_API SQLAllocHandle(SQLSMALLINT,SQLHANDLE,SQLHANDLE*); +foreign import #{CALLCONV} unsafe "sql.h SQLAllocHandle" sqlAllocHandle :: + SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn + +-- SQLRETURN SQL_API SQLFreeHandle(SQLSMALLINT,SQLHANDLE); +foreign import #{CALLCONV} unsafe "sql.h SQLFreeHandle" sqlFreeHandle :: + SqlSmallInt -> Handle -> IO SqlReturn + +-- SQLRETURN SQL_API SQLGetDiagRec(SQLSMALLINT,SQLHANDLE,SQLSMALLINT,SQLCHAR*,SQLINTEGER*,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*); +foreign import #{CALLCONV} unsafe "sql.h SQLGetDiagRec" sqlGetDiagRec :: + SqlHandleType -- ^ enum: which handle type is the next parameter? + -> Handle -- ^ generic handle ptr + -> SqlSmallInt -- ^ row (or message) number + -> MyCString -- ^ OUT: state + -> Ptr SqlInteger -- ^ OUT: error number + -> MyCString -- ^ OUT: error message + -> SqlSmallInt -- ^ IN: message buffer size + -> Ptr SqlSmallInt -- ^ OUT: message length + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLDriverConnect(SQLHDBC,SQLHWND,SQLCHAR*,SQLSMALLINT,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*,SQLUSMALLINT); +foreign import #{CALLCONV} unsafe "sql.h SQLDriverConnect" sqlDriverConnect :: + ConnHandle + -> WindowHandle -- ^ just pass nullPtr + -> MyCString -- ^ connection string + -> SqlSmallInt -- ^ connection string size + -> MyCString -- ^ OUT: buffer for normalised connection string + -> SqlSmallInt -- ^ buffer size + -> Ptr SqlSmallInt -- ^ OUT: length of returned string + -> SqlUSmallInt -- ^ enum: should driver prompt user for missing info? + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLDisconnect(SQLHDBC); +foreign import #{CALLCONV} unsafe "sql.h SQLDisconnect" sqlDisconnect :: + ConnHandle -> IO SqlReturn + +-- SQLRETURN SQL_API SQLSetEnvAttr(SQLHENV,SQLINTEGER,SQLPOINTER,SQLINTEGER); +foreign import #{CALLCONV} unsafe "sql.h SQLSetEnvAttr" sqlSetEnvAttr :: + EnvHandle -- ^ Env Handle + -> SqlInteger -- ^ Attribute (enumeration) + -> Ptr () -- ^ value (cast to void*) + -> SqlInteger -- ^ ? - set to 0 + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLSetConnectAttr(SQLHDBC,SQLINTEGER,SQLPOINTER,SQLINTEGER); +foreign import #{CALLCONV} unsafe "sql.h SQLSetConnectAttr" sqlSetConnectAttr :: + ConnHandle -- ^ Connection Handle + -> SqlInteger -- ^ Attribute (enumeration) + -> Ptr () -- ^ value (cast to void*) + -> SqlInteger -- ^ ? - set to 0 + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLPrepare(SQLHSTMT,SQLCHAR*,SQLINTEGER); +foreign import #{CALLCONV} unsafe "sql.h SQLPrepare" sqlPrepare :: + StmtHandle -> MyCString -> SqlInteger -> IO SqlReturn + +-- SQLRETURN SQL_API SQLBindParameter(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLSMALLINT,SQLSMALLINT,SQLULEN,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*); +foreign import #{CALLCONV} unsafe "sql.h SQLBindParameter" sqlBindParameter :: + StmtHandle + -> SqlUSmallInt -- ^ position, 1-indexed + -> SqlParamDirection -- ^ direction: IN, OUT + -> SqlCDataType -- ^ C data type: char, int, long, float, etc + -> SqlDataType -- ^ SQL data type: string, int, long, date, etc + -> SqlULen -- ^ col size (precision) + -> SqlSmallInt -- ^ decimal digits (scale) + -> Ptr Buffer -- ^ input+output buffer + -> SqlLen -- ^ buffer size + -> Ptr SqlLen -- ^ input+output data size, or -1 (SQL_NULL_DATA) for null + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLExecute(SQLHSTMT); +foreign import #{CALLCONV} unsafe "sql.h SQLExecute" sqlExecute :: + StmtHandle -> IO SqlReturn + +-- SQLRETURN SQL_API SQLNumResultCols(SQLHSTMT,SQLSMALLINT*); +foreign import #{CALLCONV} unsafe "sql.h SQLNumResultCols" sqlNumResultCols :: + StmtHandle -> Ptr SqlSmallInt -> IO SqlReturn + +-- SQLRETURN SQL_API SQLRowCount(SQLHSTMT,SQLLEN*); +foreign import #{CALLCONV} unsafe "sql.h SQLRowCount" sqlRowCount :: + StmtHandle -> Ptr SqlLen -> IO SqlReturn + +-- SQLRETURN SQL_API SQLDescribeCol(SQLHSTMT,SQLUSMALLINT,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*,SQLSMALLINT*,SQLULEN*,SQLSMALLINT*,SQLSMALLINT*); +foreign import #{CALLCONV} unsafe "sql.h SQLDescribeCol" sqlDescribeCol :: + StmtHandle + -> SqlUSmallInt -- ^ position, 1-indexed + -> MyCString -- ^ buffer for column name + -> SqlSmallInt -- ^ size of column name buffer + -> Ptr SqlSmallInt -- ^ size of column name output string + -> Ptr SqlDataType -- ^ SQL data type: string, int, long, date, etc + -> Ptr SqlULen -- ^ col size (precision) + -> Ptr SqlSmallInt -- ^ decimal digits (scale) + -> Ptr SqlSmallInt -- ^ nullable: SQL_NO_NULLS, SQL_NULLABLE, or SQL_NULLABLE_UNKNOWN + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLBindCol(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*); +foreign import #{CALLCONV} unsafe "sql.h SQLBindCol" sqlBindCol :: + StmtHandle + -> SqlUSmallInt -- ^ column position, 1-indexed + -> SqlDataType -- ^ SQL data type: string, int, long, date, etc + -> Ptr Buffer -- ^ output buffer + -> SqlLen -- ^ output buffer size + -> Ptr SqlLen -- ^ output data size, or -1 (SQL_NULL_DATA) for null + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLFetch(SQLHSTMT); +foreign import #{CALLCONV} unsafe "sql.h SQLFetch" sqlFetch :: + StmtHandle -> IO SqlReturn + +-- SQLRETURN SQL_API SQLGetData(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*); +foreign import #{CALLCONV} unsafe "sql.h SQLGetData" sqlGetData :: + StmtHandle + -> SqlUSmallInt -- ^ column position, 1-indexed + -> SqlDataType -- ^ SQL data type: string, int, long, date, etc + -> Ptr Buffer -- ^ output buffer + -> SqlLen -- ^ output buffer size + -> Ptr SqlLen -- ^ output data size, or -1 (SQL_NULL_DATA) for null + -> IO SqlReturn + +-- SQLRETURN SQL_API SQLCloseCursor(SQLHSTMT); +foreign import #{CALLCONV} unsafe "sql.h SQLCloseCursor" sqlCloseCursor :: + StmtHandle -> IO SqlReturn + +-- SQLRETURN SQL_API SQLMoreResults(SQLHSTMT); +foreign import #{CALLCONV} unsafe "sql.h SQLMoreResults" sqlMoreResults :: + StmtHandle -> IO SqlReturn + +-- There's no beginTrans - transactions are started implicitly. +-- SQLRETURN SQL_API SQLEndTran(SQLSMALLINT,SQLHANDLE,SQLSMALLINT); +foreign import #{CALLCONV} unsafe "sql.h SQLEndTran" sqlEndTran :: + SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn diff --git a/Database/ODBC/Test/Enumerator.lhs b/Database/ODBC/Test/Enumerator.lhs --- a/Database/ODBC/Test/Enumerator.lhs +++ b/Database/ODBC/Test/Enumerator.lhs @@ -142,7 +142,10 @@ > exceptionRollback _ = actionExceptionRollback sqlInsertTest4 sqlExceptionRollback +> iterateeMatchesResultSet _ = actionIterateeMatchesResultSet +> (prefetch 0 sqlIterateeMatchesResultSet [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int)]) + > testList :: DBLiteralValue a => [a -> DBM mark Session ()] > testList = > [ selectNoRows, selectTerminatesEarly, selectFloatsAndInts @@ -152,4 +155,5 @@ > , selectBindDate, selectBindBoundaryDates, selectRebindStmt > , boundStmtDML, boundStmtDML2 > , polymorphicFetchTest, polymorphicFetchTestNull, exceptionRollback +> , iterateeMatchesResultSet > ] diff --git a/Database/ODBC/Test/OdbcFunctions.lhs b/Database/ODBC/Test/OdbcFunctions.lhs --- a/Database/ODBC/Test/OdbcFunctions.lhs +++ b/Database/ODBC/Test/OdbcFunctions.lhs @@ -96,6 +96,18 @@ > executeStmt stmt > freeStmt stmt + +> testIsolationLevel conn = do +> -- For PostgreSQL this fails with: +> -- 206 HY009 Illegal parameter value for SQL_TXN_ISOLATION +> --setTxnIsolation conn sqlTxnReadUncommitted +> setTxnIsolation conn sqlTxnReadCommitted -- This is OK +> -- For PostgreSQL this fails with: +> -- 206 HY009 Illegal parameter value for SQL_TXN_ISOLATION +> --setTxnIsolation conn sqlTxnRepeatableRead +> setTxnIsolation conn sqlTxnSerializable -- This is OK + + > testFetchString conn = do > stmt <- allocStmt conn > let string1 = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] @@ -162,7 +174,7 @@ > executeStmt stmt > --buffer <- bindColBuffer stmt 1 sqlDTypeDouble 16 > more <- fetch stmt -> --s <- getDoubleFromBuffer buffer +> --s <- getFromBuffer buffer > s <- getData stmt 1 > let expect :: Double; expect = 123.456789 > assertEqual "testFetchDouble" (Just expect) s @@ -175,15 +187,24 @@ > flip finally (freeStmt stmt) ( do > -- There is no common SQL standard for datetime literal text. > -- Well, there is (timestamp), but MS SQL Server doesn't support it. Pah. -> prepareStmt stmt "select cast ('1916-10-01 02:25:21' as timestamp) from tdual" -> --prepareStmt stmt "select cast ('1916-10-01 02:25:21' as datetime) from tdual" +> -- And Oracle seems to also require a sane NLS setting e.g. +> -- alter session set NLS_TIMESTAMP_FORMAT = 'yyyy-mm-dd hh24:mi:ss' +> --prepareStmt stmt "alter session set NLS_TIMESTAMP_FORMAT = 'yyyy-mm-dd hh24:mi:ss'" +> --executeStmt stmt +> -- +> prepareStmt stmt "select cast ('1916-10-01 02:25:21' as timestamp), cast ('2005-10-01 00:00:00' as timestamp) from tdual" +> --prepareStmt stmt "select cast ('1916-10-01 02:25:21' as datetime), cast ('2005-10-01 00:00:00' as datetime) from tdual" +> --prepareStmt stmt "select cast ('1916-10-01 02:25:21' as timestamp) from tdual" > executeStmt stmt -> let expect :: UTCTime; expect = mkUTCTime 1916 10 1 2 25 21 -> buffer <- bindColBuffer stmt 1 0 (Just expect) +> let expect1 = mkUTCTime 1916 10 1 2 25 21 +> let expect2 = mkUTCTime 2005 10 1 0 0 0 +> buffer1 <- bindColBuffer stmt 1 0 (Just expect1) +> buffer2 <- bindColBuffer stmt 2 0 (Just expect2) > more <- fetch stmt -> t <- getUtcTimeFromBuffer buffer -> --t <- getDataUtcTime stmt 1 -> assertEqual "testFetchDatetime" (Just expect) t +> t1 <- getFromBuffer buffer1 +> t2 <- getFromBuffer buffer2 +> assertEqual "testFetchDatetime1" (Just expect1) t1 +> assertEqual "testFetchDatetime2" (Just expect2) t2 > more <- fetch stmt > assertBool "testFetchDatetime: EOD" (not more) > ) @@ -206,42 +227,29 @@ > testBindString conn = do > stmt <- allocStmt conn > prepareStmt stmt "select ? from tdual" -> let expect = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> let expect = "abcdefghijklmnopqrstuvwxyz" > bindParamBuffer stmt 1 (Just expect) > executeStmt stmt > buffer <- bindColBuffer stmt 1 1000 (Just expect) > more <- fetch stmt > s <- getUTF8StringFromBuffer buffer -> assertEqual "testBindString (PostgreSQL fails this one)" (Just expect) s +> assertEqual "testBindString" (Just expect) s > more <- fetch stmt > assertBool "testBindString: EOD" (not more) > freeStmt stmt -> printBufferContents buffer = do -> withForeignPtr (bindBufPtr buffer) $ \bptr -> do -> withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do -> sz <- peek szptr -> putStrLn ("printBufferContents: sz = " ++ show sz) -> l <- peekArray (fromIntegral sz) (castPtr bptr) -> let toHex :: Word8 -> String; toHex i = showHex i "" -> let h :: [String]; h = map toHex l -> putStrLn (concat (intersperse " " h)) - -> testUTF8 conn = do +> testBindStringUTF8 conn = do > stmt <- allocStmt conn -> prepareStmt stmt "drop table t_utf8" -> ignoreError (executeStmt stmt) -> prepareStmt stmt "create table t_utf8(s varchar(50))" -> executeStmt stmt +> prepareStmt stmt "select ? from tdual" > let expect = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] -> prepareStmt stmt ("insert into t_utf8 values ( '" ++ expect ++ "' )") -> executeStmt stmt -> prepareStmt stmt "select s from t_utf8" +> bindParamBuffer stmt 1 (Just expect) > executeStmt stmt -> buffer <- bindColBuffer stmt 1 100 (Just expect) +> buffer <- bindColBuffer stmt 1 1000 (Just expect) > more <- fetch stmt > s <- getUTF8StringFromBuffer buffer -> assertEqual "testUTF8" (Just expect) s +> assertEqual "testBindStringUTF8 (PostgreSQL fails this one)" (Just expect) s +> more <- fetch stmt +> assertBool "testBindStringUTF8: EOD" (not more) > freeStmt stmt > testBindUTCTime conn = do @@ -260,24 +268,59 @@ > ) +There seems to be a bug with the PostgreSQL ODBC driver, +where, if there is more than one datetime column in the output, +the first column gets the current date (time 00:00:00). + > testBindUTCTimeBoundary conn = do > stmt <- allocStmt conn -> prepareStmt stmt "select ?, ? from tdual" +> prepareStmt stmt "select ?, ?, ?, ? from tdual" > -- 1753 seems to be about the earliest year MS SQL Server supports. -> let expect1 :: UTCTime; expect1 = mkUTCTime 1753 1 1 0 0 0 +> --let expect1 = mkUTCTime 1753 1 1 0 0 0 +> --let expect1 = mkUTCTime 2007 3 11 0 0 0 +> let expect1 = mkUTCTime 2000 10 1 2 25 21 +> --let expect2 = mkUTCTime 2100 10 1 2 25 21 +> let expect2 = "hello2" +> let expect3 = "hello3" +> let expect4 = 444444 :: Int > let input1 = expect1 -> let expect2 :: UTCTime; expect2 = mkUTCTime 9999 10 1 2 25 21 > let input2 = expect2 -> bindParamBuffer stmt 1 (Just input1) -> bindParamBuffer stmt 2 (Just input2) +> let input3 = expect3 +> let input4 = expect4 +> putStrLn "testBindUTCTimeBoundary: data going in:" +> inbuf1 <- bindParamBuffer stmt 1 (Just input1) +> inbuf2 <- bindParamBuffer stmt 2 (Just input2) +> inbuf3 <- bindParamBuffer stmt 3 (Just input3) +> inbuf4 <- bindParamBuffer stmt 4 (Just input4) +> printBufferContents inbuf1 +> printBufferContents inbuf2 +> printBufferContents inbuf3 +> printBufferContents inbuf4 +> putStrLn "------------------------" > executeStmt stmt -> buffer1 <- bindColBuffer stmt 1 32 (Just expect1) -> buffer2 <- bindColBuffer stmt 2 32 (Just expect1) +> buffer1 <- bindColBuffer stmt 1 0 (Just expect1) +> buffer2 <- bindColBuffer stmt 2 0 (Just expect2) +> buffer3 <- bindColBuffer stmt 3 0 (Just expect3) +> buffer4 <- bindColBuffer stmt 4 0 (Just expect4) > more <- fetch stmt -> t1 <- getUtcTimeFromBuffer buffer1 -> t2 <- getUtcTimeFromBuffer buffer2 +> putStrLn "testBindUTCTimeBoundary: data coming out:" +> printBufferContents buffer1 +> printBufferContents buffer2 +> printBufferContents buffer3 +> printBufferContents buffer4 +> putStrLn "testBindUTCTimeBoundary: get1" +> t1 <- getFromBuffer buffer1 +> putStrLn "testBindUTCTimeBoundary: get2" +> t2 <- getFromBuffer buffer2 +> putStrLn "testBindUTCTimeBoundary: get3" +> t3 <- getFromBuffer buffer3 +> putStrLn "testBindUTCTimeBoundary: get4" +> t4 <- getFromBuffer buffer4 +> let x = t1 == Just expect1 > assertEqual "testBindUTCTimeBoundary1" (Just expect1) t1 -> assertEqual "testBindUTCTimeBoundary2" (Just expect2) t2 +> assertEqual "testBindUTCTimeBoundary2 (PostgreSQL fails this one)" (Just expect2) t2 +> assertEqual "testBindUTCTimeBoundary3" (Just expect3) t3 +> assertEqual "testBindUTCTimeBoundary4" (Just expect4) t4 > more <- fetch stmt > assertBool "testBindUTCTimeBoundary: EOD" (not more) > freeStmt stmt @@ -309,17 +352,39 @@ > freeStmt stmt -> testIsolationLevel conn = do -> -- For PostgreSQL this fails with: -> -- 206 HY009 Illegal parameter value for SQL_TXN_ISOLATION -> --setTxnIsolation conn sqlTxnReadUncommitted -> setTxnIsolation conn sqlTxnReadCommitted -- This is OK -> -- For PostgreSQL this fails with: -> -- 206 HY009 Illegal parameter value for SQL_TXN_ISOLATION -> --setTxnIsolation conn sqlTxnRepeatableRead -> setTxnIsolation conn sqlTxnSerializable -- This is OK +> testUTF8 conn = do +> stmt <- allocStmt conn +> prepareStmt stmt "drop table t_utf8" +> ignoreError (executeStmt stmt) +> prepareStmt stmt "create table t_utf8(s varchar(50))" +> executeStmt stmt +> let expect = "abc" ++ map chr [0x000080, 0x0007FF, 0x00FFFF, 0x10FFFF] +> prepareStmt stmt ("insert into t_utf8 values ( '" ++ expect ++ "' )") +> executeStmt stmt +> prepareStmt stmt "select s from t_utf8" +> executeStmt stmt +> buffer <- bindColBuffer stmt 1 100 (Just expect) +> more <- fetch stmt +> s <- getUTF8StringFromBuffer buffer +> assertEqual "testUTF8" (Just expect) s +> freeStmt stmt +> printBufferContents buffer = do +> withForeignPtr (bindBufPtr buffer) $ \bptr -> do +> withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do +> sz <- peek szptr +> putStrLn ("printBufferContents: sz = " ++ show sz) +> l <- peekArray (fromIntegral sz) (castPtr bptr) +> let +> toHex :: Word8 -> String; +> toHex i = (if i < 16 then "0" else "") ++ showHex i "" +> --let h :: [String]; h = map toHex l +> putStrLn (concat (intersperse " " (map toHex l))) +> let toChar :: Word8 -> String; toChar i = if i > 31 && i < 127 then [chr (fromIntegral i)] else " " +> putStrLn (concat (intersperse " " (map toChar l))) + + > testlist = > testCreateStmt : > testIsolationLevel : @@ -331,6 +396,7 @@ > testFetchDatetime : > testBindInt : > testBindString : +> testBindStringUTF8 : > testBindUTCTime : > testBindUTCTimeBoundary : > testUTF8 : diff --git a/Database/PostgreSQL/PGFunctions.lhs b/Database/PostgreSQL/PGFunctions.lhs --- a/Database/PostgreSQL/PGFunctions.lhs +++ b/Database/PostgreSQL/PGFunctions.lhs @@ -641,10 +641,14 @@ > colValPtr :: ResultSetHandle -> Int -> Int -> IO (Ptr Word8) > colValPtr rs row col = do -> n <- fPQntuples rs -> if (fromIntegral n) < row || row < 1 +> nr <- fPQntuples rs +> nc <- fPQnfields rs +> if (fromIntegral nr) < row || row < 1 > then throwPG (-1) ("Attempted fetch from invalid row number " ++ show row) -> else fPQgetvalue rs (toCInt (row-1)) (toCInt (col-1)) >>= return . castPtr +> else +> if (fromIntegral nc) < col || col < 1 +> then throwPG (-1) ("Attempted fetch from invalid column number " ++ show col) +> else fPQgetvalue rs (toCInt (row-1)) (toCInt (col-1)) >>= return . castPtr > colVal :: PGType a => ResultSetHandle -> Int -> Int -> IO a > colVal rs row col = colValPtr rs row col >>= pgPeek diff --git a/Database/PostgreSQL/Test/Enumerator.lhs b/Database/PostgreSQL/Test/Enumerator.lhs --- a/Database/PostgreSQL/Test/Enumerator.lhs +++ b/Database/PostgreSQL/Test/Enumerator.lhs @@ -228,7 +228,14 @@ > ("select count(*)::int4 from " ++ testTable) +Ensure we get an exception if the result-set columns +don't match the output buffers (at present we only +check that there aren't too many buffers +i.e. not enough columns). +> iterateeMatchesResultSet _ = actionIterateeMatchesResultSet +> (prefetch 0 sqlIterateeMatchesResultSet [bindP (1::Int), bindP (2.2::Double), bindP "row 1", bindP (3::Int)]) + > selectUTF8Text _ = do > let iter (s::String) (_::String) = result s > -- GREEK SMALL LETTER PHI : CF86 UTF8, 03C6 UTF16, 966 decimal @@ -343,5 +350,5 @@ > , boundStmtDML, boundStmtDML2 > , polymorphicFetchTest, polymorphicFetchTestNull, exceptionRollback > , selectMultiResultSet, selectNestedMultiResultSet -> , generateErrorMessageTest, selectUTF8Text +> , generateErrorMessageTest, selectUTF8Text, iterateeMatchesResultSet > ] diff --git a/Database/Sqlite/SqliteFunctions.lhs b/Database/Sqlite/SqliteFunctions.lhs --- a/Database/Sqlite/SqliteFunctions.lhs +++ b/Database/Sqlite/SqliteFunctions.lhs @@ -1,3 +1,4 @@ + > {-# OPTIONS -ffi -fglasgow-exts #-} | @@ -77,6 +78,9 @@ > foreign import ccall "sqlite.h sqlite3_exec" sqliteExec > :: DBHandle -> UTF8CString -> SqliteCallback a -> Ptr a -> Ptr CString -> IO CInt +> foreign import ccall "sqlite.h sqlite3_column_count" sqliteColumnCount +> :: StmtHandle -> IO CInt + > foreign import ccall "sqlite.h sqlite3_step" sqliteStep > :: StmtHandle -> IO CInt @@ -250,27 +254,38 @@ > rc <- sqliteReset stmt > testForError db rc () +> checkColumnRange :: StmtHandle -> Int -> IO () +> checkColumnRange stmt col = do +> nc <- sqliteColumnCount stmt +> if (fromIntegral nc < col) || col < 1 +> then throwSqlite (SqliteException (-1) ("Attempted fetch from invalid column number " ++ show col)) +> else return () + |Column numbers are zero-indexed, so subtract one from given index (we present a one-indexed interface). > colValInt :: StmtHandle -> Int -> IO Int > colValInt stmt colnum = do +> checkColumnRange stmt colnum > cint <- sqliteColumnInt stmt (fromIntegral (colnum - 1)) > return (fromIntegral cint) > colValInt64 :: StmtHandle -> Int -> IO Int64 > colValInt64 stmt colnum = do +> checkColumnRange stmt colnum > cllong <- sqliteColumnInt64 stmt (fromIntegral (colnum - 1)) > return (fromIntegral cllong) > colValDouble :: StmtHandle -> Int -> IO Double > colValDouble stmt colnum = do +> checkColumnRange stmt colnum > cdbl <- sqliteColumnDouble stmt (fromIntegral (colnum - 1)) > return (realToFrac cdbl) > colValString :: StmtHandle -> Int -> IO (Maybe String) > colValString stmt colnum = do +> checkColumnRange stmt colnum > cstrptr <- sqliteColumnText stmt (fromIntegral (colnum - 1)) > if cstrptr == nullPtr > then return Nothing @@ -280,6 +295,7 @@ > colValBlob :: StmtHandle -> Int -> IO (ForeignPtr Blob) > colValBlob stmt colnum = do +> checkColumnRange stmt colnum > let ccolnum = fromIntegral (colnum - 1) > bytes <- sqliteColumnBytes stmt ccolnum > src <- sqliteColumnBlob stmt ccolnum diff --git a/Database/Test/Enumerator.lhs b/Database/Test/Enumerator.lhs --- a/Database/Test/Enumerator.lhs +++ b/Database/Test/Enumerator.lhs @@ -397,13 +397,15 @@ > actionBoundStmtDML stmt = do > withPreparedStatement stmt $ \pstmt -> do > -- do it twice, to check that prepared stmt can be reused. +> -- Note that with bound statements, the query (or command) +> -- already been executed, so it's too late to begin the transaction. +> beginTransaction Serialisable > withBoundStatement pstmt [bindP (100::Int), bindP "100"] $ \bstmt -> do -> beginTransaction Serialisable > count <- execDML bstmt > rollback > assertEqual sqlBoundStmtDML 1 count +> beginTransaction Serialisable > withBoundStatement pstmt [bindP (100::Int), bindP "100"] $ \bstmt -> do -> beginTransaction Serialisable > count <- execDML bstmt > rollback > assertEqual sqlBoundStmtDML 1 count @@ -451,7 +453,18 @@ > gcatch ( > withTransaction Serialisable $ do > execDML insertStmt -> assertFailure "selectExhaustCursor" +> assertFailure "actionExceptionRollback" > ) (\e -> return () ) > count <- doQuery selectStmt iterExceptionRollback [] > assertEqual sqlExceptionRollback [3] count + +> sqlIterateeMatchesResultSet = "select ?,?,? from tdual" +> --iterMatchesResultSet :: (Monad m) => Int -> Double -> String -> IterAct m [(Int, Double, String)] +> --iterMatchesResultSet i d s acc = result $ (i, d, s):acc +> iterMatchesResultSet :: (Monad m) => Int -> Double -> String -> String -> IterAct m [(Int, Double, String, String)] +> iterMatchesResultSet i d s s2 acc = result $ (i, d, s, s2):acc +> actionIterateeMatchesResultSet stmt = do +> catchDB ( do +> actual <- doQuery stmt iterMatchesResultSet [] +> assertFailure "actionIterateeMatchesResultSet" +> ) (\e -> return () ) diff --git a/Takusen.cabal b/Takusen.cabal --- a/Takusen.cabal +++ b/Takusen.cabal @@ -1,5 +1,5 @@ Name: Takusen -Version: 0.8 +Version: 0.8.1 License: BSD3 License-file: LICENSE Author: Alistair Bayley, Oleg Kiselyov @@ -10,7 +10,7 @@ Package-url: http://darcs.haskell.org/takusen Category: Database Build-Depends: base, mtl, time, old-time -Build-type: Simple +Build-type: Custom Synopsis: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC. Description: Takusen is a DBMS access library. Like HSQL, we support @@ -30,7 +30,6 @@ Currently we fully support ODBC, Oracle, Sqlite, and PostgreSQL. Exposed-modules: Database.Enumerator - , Database.InternalEnumerator , Database.Util , Database.ODBC.Enumerator , Database.ODBC.OdbcFunctions @@ -45,6 +44,7 @@ , Control.Exception.MonadIO , Foreign.C.UTF8 Other-modules: + Database.InternalEnumerator -- We don't expose the Test modules; the only reason to do so would be so Haddock -- can use them (to stop the warnings "could not find link destination for:"), -- and for that they'd have to be in Exposed-modules. diff --git a/c-src/test-libpq/pgdatetest.c b/c-src/test-libpq/pgdatetest.c new file mode 100644 --- /dev/null +++ b/c-src/test-libpq/pgdatetest.c @@ -0,0 +1,115 @@ +#include +#include +/* for ntohl/htonl +#include +#include +*/ +#include "libpq-fe.h" + + +static void exit_nicely(PGconn *conn) +{ + PQfinish(conn); + exit(1); +} + + +void check_sql(PGconn *conn, PGresult *res, ExecStatusType expected) +{ + if (PQresultStatus(res) != expected) + { + fprintf(stderr, "SQL failed: %s", PQerrorMessage(conn)); + PQclear(res); + exit_nicely(conn); + } +} + +void check_cmd(PGconn *conn, PGresult *res) +{ + check_sql(conn, res, PGRES_COMMAND_OK); +} + +void check_qry(PGconn *conn, PGresult *res) +{ + check_sql(conn, res, PGRES_TUPLES_OK); +} + +void revbytes2(int n, char *pfrom, char *pto) +{ + if (n == 0) return; + *pto = *pfrom; + revbytes2(--n, ++pfrom, --pto); +} + +void revbytes(int n, void *pfrom, void *pto) +{ + revbytes2(n, (char*)pfrom, ((char*)pto)+n-1); +} + + +void printColOne(PGresult *res) +{ + double t, *tptr; + tptr = (double *) PQgetvalue(res, 0, 0); + revbytes(8, tptr, &t); + /* t = ntohl(*tptr); -- this doesn't work!? must be me... */ + printf("%f\n", t); +} + + +int main(int argc, char **argv) +{ + const char *conninfo; + PGconn *conn; + PGresult *res; + double t, *tptr; + + /* + * If the user supplies a parameter on the command line, use it as the + * conninfo string; otherwise default to setting dbname=postgres and using + * environment variables or defaults for all other connection parameters. + */ + if (argc > 1) + conninfo = argv[1]; + else + conninfo = "user = postgres"; + + /* Make a connection to the database */ + conn = PQconnectdb(conninfo); + + /* Check to see that the backend connection was successfully made */ + if (PQstatus(conn) != CONNECTION_OK) + { + fprintf(stderr, "Connection to database failed: %s", PQerrorMessage(conn)); + exit_nicely(conn); + } + + res = PQexecParams(conn, "select timestamp with time zone '1916-10-01 02:25:20'" + , 0, NULL, NULL, NULL, NULL, 1 ); + check_qry(conn, res); + printColOne(res); + PQclear(res); + + res = PQexecParams(conn, "select timestamp without time zone '1916-10-01 02:25:20'" + , 0, NULL, NULL, NULL, NULL, 1 ); + check_qry(conn, res); + printColOne(res); + PQclear(res); + + res = PQexecParams(conn, "select timestamp with time zone '1916-10-01 02:25:21'" + , 0, NULL, NULL, NULL, NULL, 1 ); + check_qry(conn, res); + printColOne(res); + PQclear(res); + + res = PQexecParams(conn, "select timestamp without time zone '1916-10-01 02:25:21'" + , 0, NULL, NULL, NULL, NULL, 1 ); + check_qry(conn, res); + printColOne(res); + PQclear(res); + + /* close the connection to the database and cleanup */ + PQfinish(conn); + + return 0; +} diff --git a/c-src/test-libpq/pgldtest.c b/c-src/test-libpq/pgldtest.c new file mode 100644 --- /dev/null +++ b/c-src/test-libpq/pgldtest.c @@ -0,0 +1,114 @@ +#include +#include +#include "libpq-fe.h" + +static void exit_nicely(PGconn *conn) +{ + PQfinish(conn); + exit(1); +} + +void check_error(PGconn *conn, PGresult *res, ExecStatusType rc, char *msg) +{ + if (PQresultStatus(res) != rc) + { + /* fprintf(stderr, msg, PQerrorMessage(conn)); */ + fprintf(stderr, "%s: %s\n", msg, PQerrorMessage(conn)); + PQclear(res); + exit_nicely(conn); + } +} + +int main(int argc, char **argv) +{ + const char *conninfo; + PGconn *conn; + PGresult *res; + int nFields; + int i, + j; + Oid paramTypes[10]; + + /* + * If the user supplies a parameter on the command line, use it as the + * conninfo string; otherwise default to setting dbname=postgres and using + * environment variables or defaults for all other connection parameters. + */ + if (argc > 1) + conninfo = argv[1]; + else + conninfo = "dbname = postgres"; + + /* Make a connection to the database */ + conn = PQconnectdb(conninfo); + + /* Check to see that the backend connection was successfully made */ + if (PQstatus(conn) != CONNECTION_OK) + { + fprintf(stderr, "Connection to database failed: %s" + , PQerrorMessage(conn)); + exit_nicely(conn); + } + + /* my test case... */ + res = PQprepare(conn, "x" + , "DECLARE myportal CURSOR FOR select * from pg_database" + , 0, paramTypes); + check_error(conn, res, PGRES_COMMAND_OK, "Prepare failed"); + + /* + * Our test case here involves using a cursor, for which we must be inside + * a transaction block. We could do the whole thing with a single + * PQexec() of "select * from pg_database", but that's too trivial to make + * a good example. + */ + + /* Start a transaction block */ + res = PQexec(conn, "BEGIN"); + check_error(conn, res, PGRES_COMMAND_OK, "BEGIN command failed"); + + /* + * Should PQclear PGresult whenever it is no longer needed to avoid memory + * leaks + */ + PQclear(res); + + /* + * Fetch rows from pg_database, the system catalog of databases + */ + res = PQexec(conn, "DECLARE myportal CURSOR FOR select * from pg_database"); + check_error(conn, res, PGRES_COMMAND_OK, "DECLARE CURSOR failed"); + PQclear(res); + + res = PQexec(conn, "FETCH ALL in myportal"); + check_error(conn, res, PGRES_TUPLES_OK, "FETCH ALL failed"); + + /* first, print out the attribute names */ + nFields = PQnfields(res); + for (i = 0; i < nFields; i++) + printf("%-15s", PQfname(res, i)); + printf("\n\n"); + + /* next, print out the rows */ + for (i = 0; i < PQntuples(res); i++) + { + for (j = 0; j < nFields; j++) + printf("%-15s", PQgetvalue(res, i, j)); + printf("\n"); + } + + PQclear(res); + + /* close the portal ... we don't bother to check for errors ... */ + res = PQexec(conn, "CLOSE myportal"); + PQclear(res); + + /* end the transaction */ + res = PQexec(conn, "END"); + PQclear(res); + + /* close the connection to the database and cleanup */ + PQfinish(conn); + + return 0; +} diff --git a/c-src/test-odbc/test.c b/c-src/test-odbc/test.c new file mode 100644 --- /dev/null +++ b/c-src/test-odbc/test.c @@ -0,0 +1,157 @@ + +#include +#include +#include +#include + + +SQLRETURN rc; + +void printDiagRecs(SQLHANDLE h, SQLSMALLINT htype, SQLSMALLINT msgSeq) +{ + char strState[6]; + char strMsg[1025]; + SQLINTEGER errNum; + SQLSMALLINT msgLen; + SQLRETURN rc2; + rc2 = SQLGetDiagRec(htype, h, msgSeq, strState, &errNum, strMsg, 1024, &msgLen); + if (SQL_SUCCESS != rc2) + { + strState[7] = '\0'; + strMsg[msgLen+1] = '\0'; + printf("%d %s %s\n", errNum, strState, strMsg); + printDiagRecs(h, htype, msgSeq+1); + } +} + +void checkRc() +{ + printf("rc = %d\n", rc); + if (! SQL_SUCCEEDED(rc)) + { + exit(1); + } +} + +void checkError(SQLRETURN rc, SQLHANDLE h, SQLSMALLINT htype) +{ + printf("checkError: rc = %d\n", rc); + if (! SQL_SUCCEEDED(rc)) + { + printDiagRecs(h, htype, 0); + exit(1); + } +} + + +SQLHANDLE allocHdl(SQLHANDLE parent, SQLSMALLINT htype) +{ + SQLHANDLE ptr; + rc = SQLAllocHandle(htype, parent, &ptr); + checkError(rc, parent, htype); + return ptr; +} + +SQLHENV allocEnv() { return allocHdl(NULL, SQL_HANDLE_ENV); } +SQLHDBC allocConn(SQLHENV env) { return allocHdl(env, SQL_HANDLE_DBC); } +SQLHSTMT allocStmt(SQLHDBC conn) { return allocHdl(conn, SQL_HANDLE_STMT); } + + +void setOdbcVer(SQLHENV env) +{ + rc = SQLSetEnvAttr(env, SQL_ATTR_ODBC_VERSION, (void*) SQL_OV_ODBC3, 0); + checkError(rc, env, SQL_HANDLE_ENV); +} + + +void odbc_connect(SQLHDBC conn, char* connstr) +{ + char outStr[1000]; + SQLSMALLINT outSz; + rc = SQLDriverConnect(conn, NULL, connstr, strlen(connstr), outStr, 1000, &outSz, SQL_DRIVER_NOPROMPT); + checkError(rc, conn, SQL_HANDLE_DBC); +} + + +void odbc_disconnect(SQLHDBC conn) +{ + rc = SQLDisconnect(conn); + checkError(rc, conn, SQL_HANDLE_DBC); +} + + +void freeHdl(SQLSMALLINT htype, SQLHANDLE h) +{ + rc = SQLFreeHandle(htype, h); + checkError(rc, h, htype); +} + +void freeEnv(SQLHENV env) { freeHdl(SQL_HANDLE_ENV, env); } +void freeConn(SQLHDBC conn) { freeHdl(SQL_HANDLE_DBC, conn); } +void freeStmt(SQLHSTMT stmt) { freeHdl(SQL_HANDLE_STMT, stmt); } + + +void prepareStmt(SQLHSTMT stmt, char* sqltext) +{ + rc = SQLPrepare(stmt, sqltext, SQL_NTS); + checkError(rc, stmt, SQL_HANDLE_STMT); +} + +void bindParamDatetime(SQLHSTMT stmt, SQLUSMALLINT pos, char* val) +{ + SQLLEN inputSz; + rc = SQLBindParameter(stmt, pos, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_TYPE_TIMESTAMP, 23, 0, val, strlen(val), &inputSz); + checkError(rc, stmt, SQL_HANDLE_STMT); +} + +void executeStmt(SQLHSTMT stmt) +{ + rc = SQLExecute(stmt); + checkError(rc, stmt, SQL_HANDLE_STMT); +} + +void bindCol () +{ +} + +SQLHDBC createConn(char *connstr) +{ + SQLHENV env; + SQLHDBC conn; + SQLHSTMT stmt; + printf("allocEnv\n"); + env = allocEnv(); + printf("setOdbcVer\n"); + setOdbcVer(env); + printf("allocConn\n"); + conn = allocConn(env); + printf("odbc_connect\n"); + odbc_connect(conn, "DSN=postgres"); + printf("allocStmt\n"); + stmt = allocStmt(conn); + printf("prepareStmt\n"); + prepareStmt(stmt, "select ?, ?, ?, ?"); + printf("bind param 1\n"); + bindParamDatetime(stmt, 1, "1753-01-01 00:00:00"); + /* + printf("bind param 2\n"); + bindParamString(stmt, 2, "hello2"); + printf("bind param 3\n"); + bindParamInt(stmt, 3, 4444); + */ + printf("executeStmt\n"); + executeStmt(stmt); + printf("freeStmt\n"); + freeStmt(stmt); + printf("disconnect\n"); + odbc_disconnect(conn); + printf("freeConn\n"); + freeConn(conn); + printf("freeEnv\n"); + freeEnv(env); +} + +int main(int argc, char** argv) +{ + createConn("DSN=postgres"); +} diff --git a/doc/html/Database-InternalEnumerator.html b/doc/html/Database-InternalEnumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-InternalEnumerator.html @@ -0,0 +1,3459 @@ + + +Database.InternalEnumerator
Takusen-0.8: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.InternalEnumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Contents
Session object. +
Exceptions and handlers +
Description

This is the interface between the middle Enumerator layer and the + low-level, Database-specific layer. This file is not exported to the end user. +

Only the programmer for a new back-end needs to consult this file. +

Synopsis
class ISession sess where
disconnect :: sess -> IO ()
beginTransaction :: sess -> IsolationLevel -> IO ()
commit :: sess -> IO ()
rollback :: sess -> IO ()
newtype ConnectA sess = ConnectA (IO sess)
class ISession sess => Statement stmt sess q | stmt sess -> q where
makeQuery :: sess -> stmt -> IO q
class ISession sess => Command stmt sess where
executeCommand :: sess -> stmt -> IO Int
class ISession sess => EnvInquiry inquirykey sess result | inquirykey sess -> result where
inquire :: inquirykey -> sess -> IO result
newtype PreparationA sess stmt = PreparationA (sess -> IO stmt)
class ISession sess => IPrepared stmt sess bound_stmt bo | stmt -> bound_stmt, stmt -> bo where
bindRun :: sess -> stmt -> [BindA sess stmt bo] -> (bound_stmt -> IO a) -> IO a
destroyStmt :: sess -> stmt -> IO ()
newtype BindA sess stmt bo = BindA (sess -> stmt -> bo)
class ISession sess => DBBind a sess stmt bo | stmt -> bo where
bindP :: a -> BindA sess stmt bo
data IsolationLevel
= ReadUncommitted
| ReadCommitted
| RepeatableRead
| Serialisable
| Serializable
type Position = Int
class ISession sess => IQuery q sess b | q -> sess, q -> b where
fetchOneRow :: q -> IO Bool
currentRowNum :: q -> IO Int
freeBuffer :: q -> b -> IO ()
destroyQuery :: q -> IO ()
class DBType a q b | q -> b where
allocBufferFor :: a -> q -> Position -> IO b
fetchCol :: q -> b -> IO a
throwIfDBNull :: Monad m => m (RowNum, ColNum) -> m (Maybe a) -> m a
data DBException
= DBError SqlState Int String
| DBFatal SqlState Int String
| DBUnexpectedNull RowNum ColNum
| DBNoData
throwDB :: DBException -> a
type ColNum = Int
type RowNum = Int
type SqlState = (SqlStateClass, SqlStateSubClass)
type SqlStateClass = String
type SqlStateSubClass = String
Session object. +
class ISession sess where

The ISession class describes a database session to a particular + DBMS. Oracle has its own Session object, SQLite has its own + session object (which maintains the connection handle to the database + engine and other related stuff). Session objects for different databases + normally have different types -- yet they all belong to the class ISession + so we can do generic operations like commit, execDDL, etc. + in a database-independent manner. +

Session objects per se are created by database connection/login functions. +

The class ISession is thus an interface between low-level (and + database-specific) code and the Enumerator, database-independent + code. + The ISession class is NOT visible to the end user -- neither the class, + nor any of its methods. +

The ISession class describes the mapping from connection object to + the session object. The connection object is created by the end user + (and this is how the end user tells which particular back end he wants). + The session object is not accessible by the end user in any way. + Even the type of the session object should be hidden! +

Methods
disconnect :: sess -> IO ()
beginTransaction :: sess -> IsolationLevel -> IO ()
commit :: sess -> IO ()
rollback :: sess -> IO ()
show/hide Instances
newtype ConnectA sess
A wrapper around the action to open the database. That wrapper is not + exported to the end user. The only reason for the wrapper is to + guarantee that the only thing to do with the result of + connect function is to pass it out + directly to withSession. +
Constructors
ConnectA (IO sess)
show/hide Instances
??? sess => Typeable (ConnectA sess)
class ISession sess => Statement stmt sess q | stmt sess -> q where
Statement defines the API for query objects i.e. + which types can be queries. +
Methods
makeQuery :: sess -> stmt -> IO q
show/hide Instances
Statement BoundStmt Session Query
Statement BoundStmt Session Query
Statement BoundStmt Session Query
Statement BoundStmt Session Query
Statement PreparedStmtObj Session Query
Statement PreparedStmtObj Session Query
Statement PreparedStmtObj Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryString Session Query
Statement QueryStringTuned Session Query
Statement QueryStringTuned Session Query
Statement QueryStringTuned Session Query
Statement StmtBind Session Query
Statement StmtBind Session Query
Statement String Session Query
Statement String Session Query
Statement String Session Query
Statement String Session Query
Statement (RefCursor StmtHandle) Session Query
Statement (RefCursor String) Session Query
Statement (NextResultSet mark PreparedStmtObj) Session Query
Statement (NextResultSet mark PreparedStmtObj) Session Query
class ISession sess => Command stmt sess where
Command is not a query: command deletes or updates rows, creates/drops + tables, or changes database state. + executeCommand returns the number of affected rows (or 0 if DDL i.e. not DML). +
Methods
executeCommand :: sess -> stmt -> IO Int
show/hide Instances
class ISession sess => EnvInquiry inquirykey sess result | inquirykey sess -> result where
Methods
inquire :: inquirykey -> sess -> IO result
show/hide Instances
newtype PreparationA sess stmt

This type is not visible to the end user (cf. ConnectA). It forms a private + `communication channel' between Database.Enumerator and a back end. +

Why don't we make a user-visible class with a prepare method? + Because it means to standardize the preparation method signature + across all databases. Some databases need more parameters, some + fewer. There may be several statement preparation functions within one + database. So, instead of standardizing the signature of the + preparation function, we standardize on the _result_ of that + function. To be more precise, we standardize on the properties of the + result: whatever it is, the eventual prepared statement should be + suitable to be passed to bindRun. +

Constructors
PreparationA (sess -> IO stmt)
class ISession sess => IPrepared stmt sess bound_stmt bo | stmt -> bound_stmt, stmt -> bo where
Methods
bindRun :: sess -> stmt -> [BindA sess stmt bo] -> (bound_stmt -> IO a) -> IO a
destroyStmt :: sess -> stmt -> IO ()
show/hide Instances
IPrepared PreparedStmtObj Session BoundStmt BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
newtype BindA sess stmt bo
The binding object (bo) below is very abstract, on purpose. + It may be |IO a|, it may be String, it may be a function, etc. + The binding object can hold the result of marshalling, + or bo can hold the current counter, etc. + Different databases do things very differently: + compare PostgreSQL and the Stub (which models Oracle). +
Constructors
BindA (sess -> stmt -> bo)
class ISession sess => DBBind a sess stmt bo | stmt -> bo where
The class DBBind is not used by the end-user. + It is used to tie up low-level database access and the enumerator. + A database-specific library must provide a set of instances for DBBind. + The latter are the dual of DBType. +
Methods
bindP :: a -> BindA sess stmt bo
This is really just a wrapper that lets us write lists of + heterogenous bind values e.g. [bindP "string", bindP (0::Int), ...] +
show/hide Instances
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj
DBBind (Maybe CalendarTime) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Float) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe Int64) Session PreparedStmtObj BindObj
DBBind (Maybe Int64) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Double)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe Int)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe StmtHandle)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe String)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe UTCTime)) Session PreparedStmtObj BindObj
Show a => DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj
DBBind (Out (Maybe a)) Session PreparedStmtObj BindObj => DBBind (Out a) Session PreparedStmtObj BindObj
data IsolationLevel
Constructors
ReadUncommitted
ReadCommitted
RepeatableRead
Serialisable
Serializablefor alternative spellers +
show/hide Instances
type Position = Int
class ISession sess => IQuery q sess b | q -> sess, q -> b where

The class IQuery describes the class of query objects. Each + database (that is, each Session object) has its own Query object. + We may assume that a Query object includes (at least, conceptually) + a (pointer to) a Session object, so a Query object determines the + Session object. + A back-end provides an instance (or instances) of IQuery. + The end user never seens the IQuery class (let alone its methods). +

Can a session have several types of query objects? + Let's assume that it can: but a statement plus the session uniquely + determine the query, +

Note that we explicitly use IO monad because we will have to explicitly + do FFI. +

Methods
fetchOneRow :: q -> IO Bool
currentRowNum :: q -> IO Int
freeBuffer :: q -> b -> IO ()
destroyQuery :: q -> IO ()
show/hide Instances
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
IQuery Query Session ColumnBuffer
class DBType a q b | q -> b where

A 'buffer' means a column buffer: a data structure that points to a + block of memory allocated for the values of one particular + column. Since a query normally fetches a row of several columns, we + typically deal with a list of column buffers. Although the column data + are typed (e.g., Integer, CalendarDate, etc), column buffers hide that + type. Think of the column buffer as Dynamics. The class DBType below + describes marshalling functions, to fetch a typed value out of the + 'untyped' columnBuffer. +

Different DBMS's (that is, different session objects) have, in + general, columnBuffers of different types: the type of Column Buffer + is specific to a database. + So, ISession (m) uniquely determines the buffer type (b)?? + Or, actually, a query uniquely determines the buffer. +

The class DBType is not used by the end-user. + It is used to tie up low-level database access and the enumerator. + A database-specific library must provide a set of instances for DBType. +

Methods
allocBufferFor :: a -> q -> Position -> IO b
fetchCol :: q -> b -> IO a
show/hide Instances
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe a) Query ColumnBuffer => DBType a Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe CalendarTime) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Double) Query ColumnBuffer
DBType (Maybe Float) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int) Query ColumnBuffer
DBType (Maybe Int64) Query ColumnBuffer
DBType (Maybe Int64) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe String) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
DBType (Maybe UTCTime) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
(Show a, Read a) => DBType (Maybe a) Query ColumnBuffer
DBType (RefCursor StmtHandle) Query ColumnBuffer
DBType (RefCursor String) Query ColumnBuffer
throwIfDBNull :: Monad m => m (RowNum, ColNum) -> m (Maybe a) -> m a
Used by instances of DBType to throw an exception + when a null (Nothing) is returned. + Will work for any type, as you pass the fetch action in the fetcher arg. +
Exceptions and handlers +
data DBException
Constructors
DBError SqlState Int StringDBMS error message. +
DBFatal SqlState Int String
DBUnexpectedNull RowNum ColNumthe iteratee function used for queries accepts both nullable (Maybe) and + non-nullable types. If the query itself returns a null in a column where a + non-nullable type was specified, we can't handle it, so DBUnexpectedNull is thrown. +
DBNoDataThrown by cursor functions if you try to fetch after the end. +
show/hide Instances
throwDB :: DBException -> a
Throw a DBException. It's just a type-specific throwDyn. +
type ColNum = Int
type RowNum = Int
type SqlState = (SqlStateClass, SqlStateSubClass)
type SqlStateClass = String
type SqlStateSubClass = String
Produced by Haddock version 0.7
diff --git a/doc/html/Database-ODBC-Enumerator.html b/doc/html/Database-ODBC-Enumerator.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-ODBC-Enumerator.html @@ -0,0 +1,514 @@ + + +Database.ODBC.Enumerator
Takusen-0.8: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.ODBC.Enumerator
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
ODBC implementation of Database.Enumerator. +
Documentation
data Session
show/hide Instances
ISession Session
Typeable Session
Command BoundStmt Session
Command QueryString Session
Command StmtBind Session
Command String Session
IQuery Query Session ColumnBuffer
Statement BoundStmt Session Query
Statement PreparedStmtObj Session Query
Statement QueryString Session Query
Statement StmtBind Session Query
Statement String Session Query
DBBind (Maybe a) Session PreparedStmtObj BindObj => DBBind a Session PreparedStmtObj BindObj
IPrepared PreparedStmtObj Session BoundStmt BindObj
DBBind (Maybe Double) Session PreparedStmtObj BindObj
DBBind (Maybe Int) Session PreparedStmtObj BindObj
DBBind (Maybe String) Session PreparedStmtObj BindObj
DBBind (Maybe UTCTime) Session PreparedStmtObj BindObj
Show a => DBBind (Maybe a) Session PreparedStmtObj BindObj
connect :: String -> ConnectA Session
prepareStmt :: QueryString -> PreparationA Session PreparedStmtObj
preparePrefetch :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareQuery :: QueryString -> PreparationA Session PreparedStmtObj
prepareLargeQuery :: Int -> QueryString -> PreparationA Session PreparedStmtObj
prepareCommand :: QueryString -> PreparationA Session PreparedStmtObj
sql :: String -> QueryString
sqlbind :: String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
prefetch :: Int -> String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
cmdbind :: String -> [BindA Session PreparedStmtObj BindObj] -> StmtBind
module Database.Enumerator
Produced by Haddock version 0.7
diff --git a/doc/html/Database-ODBC-OdbcFunctions.html b/doc/html/Database-ODBC-OdbcFunctions.html new file mode 100644 --- /dev/null +++ b/doc/html/Database-ODBC-OdbcFunctions.html @@ -0,0 +1,5628 @@ + + +Database.ODBC.OdbcFunctions
Takusen-0.8: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.ODBC.OdbcFunctions
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description
Wrappers for ODBC FFI functions, plus buffer marshaling. +
Synopsis
data HandleObj = HandleObj
type Handle = Ptr HandleObj
data EnvObj = EnvObj
type EnvHandle = Ptr EnvObj
data ConnObj = ConnObj
type ConnHandle = Ptr ConnObj
data StmtObj = StmtObj
type StmtHandle = Ptr StmtObj
type WindowHandle = Ptr ()
data Buffer = Buffer
type BufferFPtr = ForeignPtr Buffer
type SizeFPtr = ForeignPtr SqlLen
data BindBuffer = BindBuffer {
bindBufPtr :: BufferFPtr
bindBufSzPtr :: SizeFPtr
bindBufSize :: SqlLen
}
type SqlInteger = Int32
type SqlUInteger = Word32
type SqlSmallInt = Int16
type SqlUSmallInt = Word16
type SqlLen = Int32
type SqlULen = Word32
type SqlReturn = SqlSmallInt
type SqlHandleType = SqlSmallInt
type SqlDataType = SqlSmallInt
type SqlCDataType = SqlSmallInt
type SqlParamDirection = SqlSmallInt
sqlDriverNoPrompt :: SqlUSmallInt
sqlNullTermedString :: SqlInteger
sqlNullData :: SqlLen
sqlTransCommit :: SqlSmallInt
sqlTransRollback :: SqlSmallInt
sqlAutoCommitOn :: SqlInteger
sqlAutoCommitOff :: SqlInteger
data OdbcException = OdbcException Int String String [OdbcException]
catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a
throwOdbc :: OdbcException -> a
type MyCString = CString
type MyCStringLen = CStringLen
getDiagRec :: SqlReturn -> SqlHandleType -> Handle -> SqlSmallInt -> IO [OdbcException]
checkError :: SqlReturn -> SqlHandleType -> Handle -> IO ()
allocHdl :: Storable a => Handle -> SqlHandleType -> IO a
allocEnv :: IO EnvHandle
allocConn :: EnvHandle -> IO ConnHandle
allocStmt :: ConnHandle -> IO StmtHandle
freeHelper :: SqlHandleType -> Handle -> IO ()
freeEnv :: EnvHandle -> IO ()
freeConn :: ConnHandle -> IO ()
freeStmt :: StmtHandle -> IO ()
int2Ptr :: SqlInteger -> Ptr ()
setOdbcVer :: EnvHandle -> IO ()
connect :: ConnHandle -> String -> IO String
disconnect :: ConnHandle -> IO ()
prepareStmt :: StmtHandle -> String -> IO ()
executeStmt :: StmtHandle -> IO ()
closeCursor :: StmtHandle -> IO ()
rowCount :: StmtHandle -> IO Int
fetch :: StmtHandle -> IO Bool
moreResults :: StmtHandle -> IO Bool
commit :: ConnHandle -> IO ()
rollback :: ConnHandle -> IO ()
setAutoCommitOn :: ConnHandle -> IO ()
setAutoCommitOff :: ConnHandle -> IO ()
setTxnIsolation :: ConnHandle -> SqlInteger -> IO ()
getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b)
getDataStorable :: Storable a => StmtHandle -> Int -> SqlDataType -> Int -> (a -> b) -> IO (Maybe b)
getDataUtcTime :: StmtHandle -> Int -> IO (Maybe UTCTime)
getDataCStringLen :: StmtHandle -> Int -> IO (Maybe CStringLen)
getDataUTF8String :: StmtHandle -> Int -> IO (Maybe String)
getDataCString :: StmtHandle -> Int -> IO (Maybe String)
peekSmallInt :: Ptr a -> Int -> IO SqlSmallInt
peekUSmallInt :: Ptr a -> Int -> IO SqlUSmallInt
peekUInteger :: Ptr a -> Int -> IO SqlUInteger
readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime
bindColumnBuffer :: StmtHandle -> Int -> SqlDataType -> SqlLen -> IO BindBuffer
createEmptyBuffer :: SqlLen -> IO BindBuffer
testForNull :: BindBuffer -> (Ptr Buffer -> SqlLen -> IO a) -> IO (Maybe a)
getStorableFromBuffer :: Storable a => BindBuffer -> IO (Maybe a)
getCAStringFromBuffer :: BindBuffer -> IO (Maybe String)
getCWStringFromBuffer :: BindBuffer -> IO (Maybe String)
getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String)
getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime)
createBufferForStorable :: Storable a => Maybe a -> IO BindBuffer
createBufferHelper :: Storable a => a -> SqlLen -> IO BindBuffer
wrapSizedBuffer :: Ptr a -> SqlLen -> IO BindBuffer
bindParam :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> SqlULen -> SqlSmallInt -> BindBuffer -> IO ()
bindNull :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> IO BindBuffer
bindParamCStringLen :: StmtHandle -> Int -> SqlParamDirection -> Maybe CStringLen -> IO BindBuffer
bindEncodedString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> (String -> ((Ptr a, Int) -> IO BindBuffer) -> IO BindBuffer) -> IO BindBuffer
bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer
bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer
bindParamCWString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer
pokeSmallInt :: Ptr a -> Int -> SqlSmallInt -> IO ()
pokeUSmallInt :: Ptr a -> Int -> SqlUSmallInt -> IO ()
pokeUInteger :: Ptr a -> Int -> SqlUInteger -> IO ()
writeUTCTimeToMemory :: Ptr Word8 -> UTCTime -> IO ()
makeUtcTimeBuffer :: UTCTime -> IO BindBuffer
makeUtcTimeStringBuffer :: UTCTime -> IO BindBuffer
bindParamUtcTime :: StmtHandle -> Int -> SqlParamDirection -> Maybe UTCTime -> IO BindBuffer
sizeOfMaybe :: forall a . Storable a => Maybe a -> Int
newtype OutParam a = OutParam a
newtype InOutParam a = InOutParam a
class OdbcBindBuffer a where
bindColBuffer :: StmtHandle -> Int -> Int -> a -> IO BindBuffer
getFromBuffer :: BindBuffer -> IO a
getData :: StmtHandle -> Int -> IO a
class OdbcBindParam a where
bindParamBuffer :: StmtHandle -> Int -> a -> IO BindBuffer
sqlAllocHandle :: SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn
sqlFreeHandle :: SqlSmallInt -> Handle -> IO SqlReturn
sqlGetDiagRec :: SqlHandleType -> Handle -> SqlSmallInt -> MyCString -> Ptr SqlInteger -> MyCString -> SqlSmallInt -> Ptr SqlSmallInt -> IO SqlReturn
sqlDriverConnect :: ConnHandle -> WindowHandle -> MyCString -> SqlSmallInt -> MyCString -> SqlSmallInt -> Ptr SqlSmallInt -> SqlUSmallInt -> IO SqlReturn
sqlDisconnect :: ConnHandle -> IO SqlReturn
sqlSetEnvAttr :: EnvHandle -> SqlInteger -> Ptr () -> SqlInteger -> IO SqlReturn
sqlSetConnectAttr :: ConnHandle -> SqlInteger -> Ptr () -> SqlInteger -> IO SqlReturn
sqlPrepare :: StmtHandle -> MyCString -> SqlInteger -> IO SqlReturn
sqlExecute :: StmtHandle -> IO SqlReturn
sqlCloseCursor :: StmtHandle -> IO SqlReturn
sqlRowCount :: StmtHandle -> Ptr SqlLen -> IO SqlReturn
sqlGetData :: StmtHandle -> SqlUSmallInt -> SqlDataType -> Ptr Buffer -> SqlLen -> Ptr SqlLen -> IO SqlReturn
sqlBindCol :: StmtHandle -> SqlUSmallInt -> SqlDataType -> Ptr Buffer -> SqlLen -> Ptr SqlLen -> IO SqlReturn
sqlFetch :: StmtHandle -> IO SqlReturn
sqlBindParameter :: StmtHandle -> SqlUSmallInt -> SqlParamDirection -> SqlCDataType -> SqlDataType -> SqlULen -> SqlSmallInt -> Ptr Buffer -> SqlLen -> Ptr SqlLen -> IO SqlReturn
sqlMoreResults :: StmtHandle -> IO SqlReturn
sqlEndTran :: SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn
Documentation
data HandleObj
Constructors
HandleObj
type Handle = Ptr HandleObj
data EnvObj
Constructors
EnvObj
type EnvHandle = Ptr EnvObj
data ConnObj
Constructors
ConnObj
type ConnHandle = Ptr ConnObj
data StmtObj
Constructors
StmtObj
type StmtHandle = Ptr StmtObj
type WindowHandle = Ptr ()
data Buffer
Constructors
Buffer
type BufferFPtr = ForeignPtr Buffer
type SizeFPtr = ForeignPtr SqlLen
data BindBuffer
Constructors
BindBuffer
bindBufPtr :: BufferFPtr
bindBufSzPtr :: SizeFPtr
bindBufSize :: SqlLen
type SqlInteger = Int32
type SqlUInteger = Word32
type SqlSmallInt = Int16
type SqlUSmallInt = Word16
type SqlLen = Int32
type SqlULen = Word32
type SqlReturn = SqlSmallInt
type SqlHandleType = SqlSmallInt
type SqlDataType = SqlSmallInt
type SqlCDataType = SqlSmallInt
type SqlParamDirection = SqlSmallInt
sqlDriverNoPrompt :: SqlUSmallInt
sqlNullTermedString :: SqlInteger
sqlNullData :: SqlLen
sqlTransCommit :: SqlSmallInt
sqlTransRollback :: SqlSmallInt
sqlAutoCommitOn :: SqlInteger
sqlAutoCommitOff :: SqlInteger
data OdbcException
Constructors
OdbcException Int String String [OdbcException]
show/hide Instances
catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a
throwOdbc :: OdbcException -> a
type MyCString = CString
type MyCStringLen = CStringLen
getDiagRec :: SqlReturn -> SqlHandleType -> Handle -> SqlSmallInt -> IO [OdbcException]
checkError :: SqlReturn -> SqlHandleType -> Handle -> IO ()
allocHdl :: Storable a => Handle -> SqlHandleType -> IO a
allocEnv :: IO EnvHandle
allocConn :: EnvHandle -> IO ConnHandle
allocStmt :: ConnHandle -> IO StmtHandle
freeHelper :: SqlHandleType -> Handle -> IO ()
freeEnv :: EnvHandle -> IO ()
freeConn :: ConnHandle -> IO ()
freeStmt :: StmtHandle -> IO ()
int2Ptr :: SqlInteger -> Ptr ()
setOdbcVer :: EnvHandle -> IO ()
connect :: ConnHandle -> String -> IO String
disconnect :: ConnHandle -> IO ()
prepareStmt :: StmtHandle -> String -> IO ()
executeStmt :: StmtHandle -> IO ()
closeCursor :: StmtHandle -> IO ()
rowCount :: StmtHandle -> IO Int
fetch :: StmtHandle -> IO Bool
Return True if there are more rows, False if end-of-data. +
moreResults :: StmtHandle -> IO Bool
commit :: ConnHandle -> IO ()
rollback :: ConnHandle -> IO ()
setAutoCommitOn :: ConnHandle -> IO ()
setAutoCommitOff :: ConnHandle -> IO ()
setTxnIsolation :: ConnHandle -> SqlInteger -> IO ()
getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b)
getDataStorable :: Storable a => StmtHandle -> Int -> SqlDataType -> Int -> (a -> b) -> IO (Maybe b)
getDataUtcTime :: StmtHandle -> Int -> IO (Maybe UTCTime)
getDataCStringLen :: StmtHandle -> Int -> IO (Maybe CStringLen)
getDataUTF8String :: StmtHandle -> Int -> IO (Maybe String)
getDataCString :: StmtHandle -> Int -> IO (Maybe String)
peekSmallInt :: Ptr a -> Int -> IO SqlSmallInt
peekUSmallInt :: Ptr a -> Int -> IO SqlUSmallInt
peekUInteger :: Ptr a -> Int -> IO SqlUInteger
readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime
bindColumnBuffer :: StmtHandle -> Int -> SqlDataType -> SqlLen -> IO BindBuffer
createEmptyBuffer :: SqlLen -> IO BindBuffer
testForNull :: BindBuffer -> (Ptr Buffer -> SqlLen -> IO a) -> IO (Maybe a)
getStorableFromBuffer :: Storable a => BindBuffer -> IO (Maybe a)
getCAStringFromBuffer :: BindBuffer -> IO (Maybe String)
getCWStringFromBuffer :: BindBuffer -> IO (Maybe String)
getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String)
getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime)
createBufferForStorable :: Storable a => Maybe a -> IO BindBuffer
createBufferHelper :: Storable a => a -> SqlLen -> IO BindBuffer
wrapSizedBuffer :: Ptr a -> SqlLen -> IO BindBuffer
bindParam :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> SqlULen -> SqlSmallInt -> BindBuffer -> IO ()
bindNull :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> IO BindBuffer
bindParamCStringLen :: StmtHandle -> Int -> SqlParamDirection -> Maybe CStringLen -> IO BindBuffer
bindEncodedString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> (String -> ((Ptr a, Int) -> IO BindBuffer) -> IO BindBuffer) -> IO BindBuffer
bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer
bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer
bindParamCWString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> IO BindBuffer
pokeSmallInt :: Ptr a -> Int -> SqlSmallInt -> IO ()
pokeUSmallInt :: Ptr a -> Int -> SqlUSmallInt -> IO ()
pokeUInteger :: Ptr a -> Int -> SqlUInteger -> IO ()
writeUTCTimeToMemory :: Ptr Word8 -> UTCTime -> IO ()
makeUtcTimeBuffer :: UTCTime -> IO BindBuffer
makeUtcTimeStringBuffer :: UTCTime -> IO BindBuffer
bindParamUtcTime :: StmtHandle -> Int -> SqlParamDirection -> Maybe UTCTime -> IO BindBuffer
sizeOfMaybe :: forall a . Storable a => Maybe a -> Int
newtype OutParam a
Constructors
OutParam a
newtype InOutParam a
Constructors
InOutParam a
class OdbcBindBuffer a where
Methods
bindColBuffer
:: StmtHandlestmt handle +
-> Intcolumn position (1-indexed) +
-> Intsize of result buffer (ignored when it can be inferred from type of a) +
-> adummy value of the appropriate type (just to ensure we get the right class instance) +
-> IO BindBufferreturns a BindBuffer object +
getFromBuffer :: BindBuffer -> IO a
getData :: StmtHandle -> Int -> IO a
show/hide Instances
class OdbcBindParam a where
Methods
bindParamBuffer
:: StmtHandlestmt handle +
-> Intparameter position (1-indexed) +
-> avalue to write to buffer +
-> IO BindBufferreturns a BindBuffer object +
show/hide Instances
sqlAllocHandle :: SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn
sqlFreeHandle :: SqlSmallInt -> Handle -> IO SqlReturn
sqlGetDiagRec
:: SqlHandleTypeenum: which handle type is the next parameter? +
-> Handlegeneric handle ptr +
-> SqlSmallIntrow (or message) number +
-> MyCStringOUT: state +
-> Ptr SqlIntegerOUT: error number +
-> MyCStringOUT: error message +
-> SqlSmallIntIN: message buffer size +
-> Ptr SqlSmallIntOUT: message length +
-> IO SqlReturn
sqlDriverConnect
:: ConnHandle
-> WindowHandlejust pass nullPtr +
-> MyCStringconnection string +
-> SqlSmallIntconnection string size +
-> MyCStringOUT: buffer for normalised connection string +
-> SqlSmallIntbuffer size +
-> Ptr SqlSmallIntOUT: length of returned string +
-> SqlUSmallIntenum: should driver prompt user for missing info? +
-> IO SqlReturn
sqlDisconnect :: ConnHandle -> IO SqlReturn
sqlSetEnvAttr
:: EnvHandleEnv Handle +
-> SqlIntegerAttribute (enumeration) +
-> Ptr ()value (cast to void*) +
-> SqlInteger? - set to 0 +
-> IO SqlReturn
sqlSetConnectAttr
:: ConnHandleConnection Handle +
-> SqlIntegerAttribute (enumeration) +
-> Ptr ()value (cast to void*) +
-> SqlInteger? - set to 0 +
-> IO SqlReturn
sqlPrepare :: StmtHandle -> MyCString -> SqlInteger -> IO SqlReturn
sqlExecute :: StmtHandle -> IO SqlReturn
sqlCloseCursor :: StmtHandle -> IO SqlReturn
sqlRowCount :: StmtHandle -> Ptr SqlLen -> IO SqlReturn
sqlGetData
:: StmtHandle
-> SqlUSmallIntcolumn position, 1-indexed +
-> SqlDataTypeSQL data type: string, int, long, date, etc +
-> Ptr Bufferoutput buffer +
-> SqlLenoutput buffer size +
-> Ptr SqlLenoutput data size, or -1 (SQL_NULL_DATA) for null +
-> IO SqlReturn
sqlBindCol
:: StmtHandle
-> SqlUSmallIntcolumn position, 1-indexed +
-> SqlDataTypeSQL data type: string, int, long, date, etc +
-> Ptr Bufferoutput buffer +
-> SqlLenoutput buffer size +
-> Ptr SqlLenoutput data size, or -1 (SQL_NULL_DATA) for null +
-> IO SqlReturn
sqlFetch :: StmtHandle -> IO SqlReturn
sqlBindParameter
:: StmtHandle
-> SqlUSmallIntposition, 1-indexed +
-> SqlParamDirectiondirection: IN, OUT +
-> SqlCDataTypeC data type: char, int, long, float, etc +
-> SqlDataTypeSQL data type: string, int, long, date, etc +
-> SqlULencol size (precision) +
-> SqlSmallIntdecimal digits (scale) +
-> Ptr Bufferinput+output buffer +
-> SqlLenbuffer size +
-> Ptr SqlLeninput+output data size, or -1 (SQL_NULL_DATA) for null +
-> IO SqlReturn
sqlMoreResults :: StmtHandle -> IO SqlReturn
sqlEndTran :: SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn
Produced by Haddock version 0.7
diff --git a/doc/html/Foreign-C-UTF8.html b/doc/html/Foreign-C-UTF8.html new file mode 100644 --- /dev/null +++ b/doc/html/Foreign-C-UTF8.html @@ -0,0 +1,523 @@ + + +Foreign.C.UTF8
Takusen-0.8: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Foreign.C.UTF8
Portabilityportable
Stabilityexperimental
Maintaineralistair@abayley.org
Description

Marshall Haskell Strings to and from UTF8-encoded CStrings. + This module's code is inspired by John Meacham's UTF8 en- & de-coders, + and also those found in the HXT library (module Text.XML.HXT.DOM.Unicode). +

Note that the -Len functions all return the length in bytes, + not Chars (this is more useful, as you are most likely to want + to pass the length to an FFI function, which is most likely + expecting the length in bytes). If you want the length in Chars, + well, you have the original String, so... +

Synopsis
peekUTF8String :: CString -> IO String
peekUTF8StringLen :: CStringLen -> IO String
newUTF8String :: String -> IO CString
withUTF8String :: String -> (CString -> IO a) -> IO a
withUTF8StringLen :: String -> (CStringLen -> IO a) -> IO a
toUTF8String :: String -> String
fromUTF8String :: String -> String
lengthUTF8 :: String -> Int
fromUTF8 :: [Word8] -> String
toUTF8 :: String -> [Word8]
Documentation
peekUTF8String :: CString -> IO String
Analogous to peekCString. Converts UTF8 CString to String. +
peekUTF8StringLen :: CStringLen -> IO String
Analogous to peekCStringLen. Converts UTF8 CString to String. + The resulting String will end either when len bytes + have been converted, or when a NULL is found. +
newUTF8String :: String -> IO CString
Analogous to newCString. Creates UTF8 encoded CString. +
withUTF8String :: String -> (CString -> IO a) -> IO a
Analogous to withCString. Creates UTF8 encoded CString. +
withUTF8StringLen :: String -> (CStringLen -> IO a) -> IO a
Analogous to withCStringLen. + The length returned is in bytes (encoding units), not chars. +
toUTF8String :: String -> String
Convert a Haskell String into a UTF8 String, where each UTF8 byte + is represented by its Char equivalent i.e. only chars 0-255 are used. + The resulting String can be marshalled to CString directly i.e. with + a Latin-1 encoding. +
fromUTF8String :: String -> String
Convert a String that was marshalled from a CString without + any decoder applied. This might be useful if the client encoding + is unknown, and the user code must convert. + We assume that the UTF8 CString was marshalled as if Latin-1 + i.e. all chars are in the range 0-255. +
lengthUTF8 :: String -> Int
fromUTF8 :: [Word8] -> String
Convert UTF-8 to Unicode. +
toUTF8 :: String -> [Word8]
Convert Unicode characters to UTF-8. +
Produced by Haddock version 0.7