Menu
▾
▴
[htoolkit-cvs] HSQL/MySQL HSQL.hsc,1.5,1.6
|
From: <kr_...@us...> - 2003-09-25 17:51:36
|
Update of /cvsroot/htoolkit/HSQL/MySQL
In directory sc8-pr-cvs1:/tmp/cvs-serv15123
Modified Files:
HSQL.hsc
Log Message:
Allow fetching of strings with null characters. As side effect this will speedup fetching of columns of type Int.
Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MySQL/HSQL.hsc,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** HSQL.hsc 25 Sep 2003 17:20:01 -0000 1.5
--- HSQL.hsc 25 Sep 2003 17:51:32 -0000 1.6
***************
*** 44,47 ****
--- 44,48 ----
type MYSQL_FIELD = Ptr ()
type MYSQL_ROW = Ptr CString
+ type MYSQL_LENGTHS = Ptr CULong
foreign import ccall "mysql.h mysql_init" mysql_init :: MYSQL -> IO MYSQL
***************
*** 55,58 ****
--- 56,63 ----
foreign import ccall "mysql.h mysql_free_result" mysql_free_result :: MYSQL_RES -> IO ()
foreign import ccall "mysql.h mysql_fetch_row" mysql_fetch_row :: MYSQL_RES -> IO MYSQL_ROW
+ foreign import ccall "mysql.h mysql_fetch_lengths" mysql_fetch_lengths :: MYSQL_RES -> IO MYSQL_LENGTHS
+
+ foreign import ccall "stdlib.h atoi" c_atoi :: CString -> IO Int
+ foreign import ccall "stdlib.h strtoll" c_strtoll :: CString -> Ptr CString -> Int -> IO Int64
newtype Connection = Connection MYSQL
***************
*** 61,67 ****
= Statement
{ pRes :: !MYSQL_RES
! , connection :: !Connection
! , fields :: ![FieldDef]
! , currRow :: IORef MYSQL_ROW
}
--- 66,72 ----
= Statement
{ pRes :: !MYSQL_RES
! , connection :: !Connection
! , fields :: ![FieldDef]
! , currRow :: IORef (MYSQL_ROW, MYSQL_LENGTHS)
}
***************
*** 168,172 ****
res <- withCString query (mysql_query pMYSQL)
when (res /= 0) (handleSqlError pMYSQL)
! currRow <- newIORef nullPtr
pRes <- mysql_use_result pMYSQL
if (pRes == nullPtr)
--- 173,177 ----
res <- withCString query (mysql_query pMYSQL)
when (res /= 0) (handleSqlError pMYSQL)
! currRow <- newIORef (nullPtr, nullPtr)
pRes <- mysql_use_result pMYSQL
if (pRes == nullPtr)
***************
*** 221,225 ****
| otherwise = do
pRow <- mysql_fetch_row pRes
! writeIORef currRow pRow
return (pRow /= nullPtr)
--- 226,231 ----
| otherwise = do
pRow <- mysql_fetch_row pRes
! pLengths <- mysql_fetch_lengths pRes
! writeIORef currRow (pRow, pLengths)
return (pRow /= nullPtr)
***************
*** 252,261 ****
--- 258,298 ----
class SqlBind a where
+ -- This allows for faster conversion for eq. integral numeric types, etc.
+ -- Default version uses fromSqlValue.
+ fromNonNullSqlCStringLen :: SqlType -> CString -> Int -> IO (Maybe a)
+ fromNonNullSqlCStringLen sqlType cstr cstrLen = do
+ str <- peekCStringLen (cstr, cstrLen)
+ return (fromSqlValue sqlType str)
+
fromSqlValue :: SqlType -> String -> Maybe a
toSqlValue :: a -> String
instance SqlBind Int where
+ fromNonNullSqlCStringLen sqlType cstr cstrLen = do
+ if sqlType==SqlInteger || sqlType==SqlSmallInt
+ then do
+ val <- c_atoi cstr
+ return (Just val)
+ else
+ return Nothing
+
+ fromSqlValue SqlInteger s = Just (read s)
+ fromSqlValue SqlSmallInt s = Just (read s)
+ fromSqlValue _ s = Nothing
+
+ toSqlValue val = show val
+
+ instance SqlBind Int64 where
+ fromNonNullSqlCStringLen sqlType cstr cstrLen = do
+ if sqlType==SqlInteger || sqlType==SqlSmallInt || sqlType==SqlBigInt
+ then do
+ val <- c_strtoll cstr nullPtr 10
+ return (Just val)
+ else
+ return Nothing
+
fromSqlValue SqlInteger s = Just (read s)
fromSqlValue SqlSmallInt s = Just (read s)
+ fromSqlValue SqlBigInt s = Just (read s)
fromSqlValue _ s = Nothing
***************
*** 379,400 ****
-- | Retrieves the value of field with the specified name.
-- The returned value is Nothing if the field value is @null@.
! getFieldValueMB :: SqlBind a => Statement
! -> String -- ^ Field name
! -> IO (Maybe a) -- ^ Field value or Nothing
getFieldValueMB (Statement {currRow=currRow, fields=fieldDefs}) name = do
! row <- readIORef currRow
let (sqlType,nullable,colNumber) = findFieldInfo name fieldDefs 0
pValue <- peekElemOff row colNumber
if pValue == nullPtr
then return Nothing
else do
! value <- peekCString pValue
! case fromSqlValue sqlType value of
! Just v -> return (Just v)
! Nothing -> throwDyn (SqlBadTypeCast name sqlType)
-- | Retrieves the value of field with the specified name.
-- If the field value is @null@ then the function will throw 'SqlFetchNull' exception.
! getFieldValue :: SqlBind a => Statement
-> String -- ^ Field name
-> IO a -- ^ Field value
--- 416,438 ----
-- | Retrieves the value of field with the specified name.
-- The returned value is Nothing if the field value is @null@.
! getFieldValueMB :: SqlBind a => Statement
! -> String -- ^ Field name
! -> IO (Maybe a) -- ^ Field value or Nothing
getFieldValueMB (Statement {currRow=currRow, fields=fieldDefs}) name = do
! (row, lengths) <- readIORef currRow
let (sqlType,nullable,colNumber) = findFieldInfo name fieldDefs 0
pValue <- peekElemOff row colNumber
+ len <- fmap fromIntegral (peekElemOff lengths colNumber)
if pValue == nullPtr
then return Nothing
else do
! mv <- fromNonNullSqlCStringLen sqlType pValue len
! case mv of
! Just v -> return (Just v)
! Nothing -> throwDyn (SqlBadTypeCast name sqlType)
-- | Retrieves the value of field with the specified name.
-- If the field value is @null@ then the function will throw 'SqlFetchNull' exception.
! getFieldValue :: SqlBind a => Statement
-> String -- ^ Field name
-> IO a -- ^ Field value
***************
*** 407,411 ****
-- | Retrieves the value of field with the specified name.
-- If the field value is @null@ then the function will return the default value.
! getFieldValue' :: SqlBind a => Statement
-> String -- ^ Field name
-> a -- ^ Default field value
--- 445,449 ----
-- | Retrieves the value of field with the specified name.
-- If the field value is @null@ then the function will return the default value.
! getFieldValue' :: SqlBind a => Statement
-> String -- ^ Field name
-> a -- ^ Default field value
|
