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 = 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
(
sqlRcInvalidHandle :
sqlRcStillExecuting :
sqlRcSuccess :
sqlRcSuccessWithInfo :
sqlRcError :
sqlRcNeedData :
sqlRcNoData :
[]) =
(
2 :
2 :
0 :
1 :
1 :
99 :
100 :
[]) :: [SqlReturn]
showReturnCode rc
| rc == 2 = "SQL_INVALID_HANDLE"
| rc == 2 = "SQL_STILL_EXECUTING"
| rc == 0 = "SQL_SUCCESS"
| rc == 1 = "SQL_SUCCESS_WITH_INFO"
| rc == 1 = "SQL_ERROR"
| rc == 99 = "SQL_NEED_DATA"
| rc == 100 = "SQL_NO_DATA"
| otherwise = "UNKNOWN_RETURN_CODE"
(
sqlHTypeEnv :
sqlHTypeConn :
sqlHTypeStmt :
sqlHTypeDesc :
[]) =
(
1 :
2 :
3 :
4 :
[]) :: [SqlHandleType]
sqlDriverNoPrompt :: SqlUSmallInt
sqlDriverNoPrompt = 0
sqlNullTermedString :: SqlInteger
sqlNullTermedString = 3
sqlNullData :: SqlLen
sqlNullData = 1
sqlTransCommit :: SqlSmallInt
sqlTransCommit = 0
sqlTransRollback :: SqlSmallInt
sqlTransRollback = 1
sqlAutoCommitOn, sqlAutoCommitOff :: SqlInteger
sqlAutoCommitOn = 1
sqlAutoCommitOff = 0
(
sqlAttrOdbcVersion :
sqlAttrAutoCommit :
sqlAttrTxnIsolation :
[]) =
(
200 :
102 :
108 :
[]) :: [SqlInteger]
(
sqlOvOdbc3 :
sqlTxnCapable :
sqlDefaultTxnIsolation :
sqlTxnIsolationOption :
sqlTxnReadUncommitted :
sqlTxnReadCommitted :
sqlTxnRepeatableRead :
sqlTxnSerializable :
[]) =
(
3 :
46 :
26 :
72 :
1 :
2 :
4 :
8 :
[]) :: [SqlInteger]
(
sqlDTypeString :
sqlDTypeInt :
sqlDTypeBinary :
sqlDTypeDouble :
sqlDTypeDate :
sqlDTypeTime :
sqlDTypeTimestamp :
sqlDTypeCursor :
[]) =
(
1 :
4 :
2 :
8 :
91 :
92 :
93 :
6 :
[]) :: [SqlDataType]
(
sqlCTypeString :
sqlCTypeInt :
sqlCTypeBinary :
sqlCTypeDouble :
sqlCTypeDate :
sqlCTypeTime :
sqlCTypeTimestamp :
[]) =
(
1 :
4 :
2 :
8 :
91 :
92 :
93 :
[]) :: [SqlCDataType]
(
sqlParamInput :
sqlParamInputOutput :
sqlParamOutput :
sqlParamDefault :
sqlParamUnknown :
[] ) =
(
1 :
2 :
4 :
2 :
0 :
[] ) :: [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
sqlSucceeded rc = rc == sqlRcSuccess || rc == sqlRcSuccessWithInfo
type MyCString = CString
type MyCStringLen = CStringLen
myPeekCStringLen p = peekUTF8StringLen p
myWithCString s = withUTF8String s
myWithCStringLen s = withUTF8StringLen 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
case () of
_ | rc == sqlRcSuccess -> do
errnum <- peek errorNumPtr
state <- myPeekCStringLen (cstrState, 5)
msglen <- peek msgLenPtr
msg <- myPeekCStringLen (cstrMsg, fromIntegral msglen)
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)
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)
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 (16) $ \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
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
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
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
readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime
readUtcTimeFromMemory buffer = do
year <- peekSmallInt buffer (0)
month <- peekUSmallInt buffer (2)
day <- peekUSmallInt buffer (4)
hour <- peekUSmallInt buffer (6)
minute <- peekUSmallInt buffer (8)
second <- peekUSmallInt buffer (10)
frac <- peekUInteger buffer (12)
let secs :: Double; secs = fromIntegral second + (fromIntegral frac / 1000000000.0)
return (mkUTCTime (fromIntegral year) month day hour minute second)
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
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)
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 (0) (fromIntegral year)
pokeUSmallInt buffer (2) (fromIntegral month)
pokeUSmallInt buffer (4) (fromIntegral day)
pokeUSmallInt buffer (6) (fromIntegral hour)
pokeUSmallInt buffer (8) (fromIntegral minute)
let (secs, frac) = properFraction second
let fraction :: SqlUInteger; fraction = round (frac * 1000000000.0)
pokeUSmallInt buffer (10) secs
pokeUInteger buffer (12) fraction
makeUtcTimeBuffer :: UTCTime -> IO BindBuffer
makeUtcTimeBuffer utc = do
mem <- mallocBytes (16)
writeUTCTimeToMemory (castPtr mem) utc
wrapSizedBuffer mem (16)
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
buffer <- makeUtcTimeStringBuffer utc
withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do
size <- peek szptr
bindParam stmt pos direction sqlCTypeString sqlDTypeTimestamp 23 0 buffer
return buffer
sizeOfMaybe :: forall a. Storable a => Maybe a -> Int
sizeOfMaybe _ = sizeOf ( undefined :: a )
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
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 (16)
getFromBuffer buffer = getUtcTimeFromBuffer buffer
getData stmt pos = getDataUtcTime stmt pos
class OdbcBindParam a where
bindParamBuffer
:: StmtHandle
-> Int
-> a
-> IO BindBuffer
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
foreign import ccall unsafe "sql.h SQLAllocHandle" sqlAllocHandle ::
SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLFreeHandle" sqlFreeHandle ::
SqlSmallInt -> Handle -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLGetDiagRec" sqlGetDiagRec ::
SqlHandleType
-> Handle
-> SqlSmallInt
-> MyCString
-> Ptr SqlInteger
-> MyCString
-> SqlSmallInt
-> Ptr SqlSmallInt
-> IO SqlReturn
foreign import ccall unsafe "sql.h SQLDriverConnect" sqlDriverConnect ::
ConnHandle
-> WindowHandle
-> MyCString
-> SqlSmallInt
-> MyCString
-> SqlSmallInt
-> Ptr SqlSmallInt
-> SqlUSmallInt
-> IO SqlReturn
foreign import ccall unsafe "sql.h SQLDisconnect" sqlDisconnect ::
ConnHandle -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLSetEnvAttr" sqlSetEnvAttr ::
EnvHandle
-> SqlInteger
-> Ptr ()
-> SqlInteger
-> IO SqlReturn
foreign import ccall unsafe "sql.h SQLSetConnectAttr" sqlSetConnectAttr ::
ConnHandle
-> SqlInteger
-> Ptr ()
-> SqlInteger
-> IO SqlReturn
foreign import ccall unsafe "sql.h SQLPrepare" sqlPrepare ::
StmtHandle -> MyCString -> SqlInteger -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLExecute" sqlExecute ::
StmtHandle -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLCloseCursor" sqlCloseCursor ::
StmtHandle -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLRowCount" sqlRowCount ::
StmtHandle -> Ptr SqlLen -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLGetData" sqlGetData ::
StmtHandle
-> SqlUSmallInt
-> SqlDataType
-> Ptr Buffer
-> SqlLen
-> Ptr SqlLen
-> IO SqlReturn
foreign import ccall unsafe "sql.h SQLBindCol" sqlBindCol ::
StmtHandle
-> SqlUSmallInt
-> SqlDataType
-> Ptr Buffer
-> SqlLen
-> Ptr SqlLen
-> IO SqlReturn
foreign import ccall unsafe "sql.h SQLFetch" sqlFetch ::
StmtHandle -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLBindParameter" sqlBindParameter ::
StmtHandle
-> SqlUSmallInt
-> SqlParamDirection
-> SqlCDataType
-> SqlDataType
-> SqlULen
-> SqlSmallInt
-> Ptr Buffer
-> SqlLen
-> Ptr SqlLen
-> IO SqlReturn
foreign import ccall unsafe "sql.h SQLMoreResults" sqlMoreResults ::
StmtHandle -> IO SqlReturn
foreign import ccall unsafe "sql.h SQLEndTran" sqlEndTran ::
SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn