hsql-mysql 1.7.1 → 1.8.1
raw patch · 7 files changed
+325/−227 lines, 7 filesdep −old-timedep ~basedep ~hsqlnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies removed: old-time
Dependency ranges changed: base, hsql
API changes (from Hackage documentation)
+ DB.HSQL.MySQL.Functions: fetch :: MYSQL_RES -> MVar (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool
+ DB.HSQL.MySQL.Functions: getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a
+ DB.HSQL.MySQL.Functions: handleSqlError :: MYSQL -> IO a
+ DB.HSQL.MySQL.Functions: mysqlDefaultConnectFlags :: CInt
+ DB.HSQL.MySQL.Functions: mysql_close :: MYSQL -> IO ()
+ DB.HSQL.MySQL.Functions: mysql_errno :: MYSQL -> IO CInt
+ DB.HSQL.MySQL.Functions: mysql_error :: MYSQL -> IO CString
+ DB.HSQL.MySQL.Functions: mysql_fetch_field :: MYSQL_RES -> IO MYSQL_FIELD
+ DB.HSQL.MySQL.Functions: mysql_fetch_lengths :: MYSQL_RES -> IO MYSQL_LENGTHS
+ DB.HSQL.MySQL.Functions: mysql_fetch_row :: MYSQL_RES -> IO MYSQL_ROW
+ DB.HSQL.MySQL.Functions: mysql_free_result :: MYSQL_RES -> IO ()
+ DB.HSQL.MySQL.Functions: mysql_init :: MYSQL -> IO MYSQL
+ DB.HSQL.MySQL.Functions: mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES
+ DB.HSQL.MySQL.Functions: mysql_list_tables :: MYSQL -> CString -> IO MYSQL_RES
+ DB.HSQL.MySQL.Functions: mysql_next_result :: MYSQL -> IO CInt
+ DB.HSQL.MySQL.Functions: mysql_query :: MYSQL -> CString -> IO CInt
+ DB.HSQL.MySQL.Functions: mysql_real_connect :: MYSQL -> CString -> CString -> CString -> CString -> CInt -> CString -> CInt -> IO MYSQL
+ DB.HSQL.MySQL.Functions: mysql_use_result :: MYSQL -> IO MYSQL_RES
+ DB.HSQL.MySQL.Functions: withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
+ DB.HSQL.MySQL.Type: mkSqlType :: Int -> Int -> Int -> SqlType
+ DB.HSQL.MySQL.Type: type MYSQL = Ptr ()
+ DB.HSQL.MySQL.Type: type MYSQL_FIELD = Ptr ()
+ DB.HSQL.MySQL.Type: type MYSQL_LENGTHS = Ptr CULong
+ DB.HSQL.MySQL.Type: type MYSQL_RES = Ptr ()
+ DB.HSQL.MySQL.Type: type MYSQL_ROW = Ptr CString
Files
- ChangeLog +2/−0
- DB/HSQL/MySQL/Functions.hsc +140/−0
- DB/HSQL/MySQL/Type.hsc +41/−0
- Database/HSQL/MySQL.hs +106/−0
- Database/HSQL/MySQL.hsc +0/−223
- LICENSE +29/−0
- hsql-mysql.cabal +7/−4
+ ChangeLog view
@@ -0,0 +1,2 @@+2010-1-31+ 1.8.1: uses updated exception handling of hsql-1.8.1; refactorings
+ DB/HSQL/MySQL/Functions.hsc view
@@ -0,0 +1,140 @@+module DB.HSQL.MySQL.Functions where++import Foreign((.&.),peekByteOff,nullPtr,peekElemOff)+import Foreign.C(CInt,CString,peekCString)+import Control.Concurrent.MVar(MVar,newMVar,modifyMVar,readMVar)+import Control.Exception (throw)+import Control.Monad(when)++import Database.HSQL.Types(FieldDef,Statement(..),Connection(..),SqlError(..))+import DB.HSQL.MySQL.Type(MYSQL,MYSQL_RES,MYSQL_FIELD,MYSQL_ROW,MYSQL_LENGTHS+ ,mkSqlType)++#include <HsMySQL.h>++#ifdef mingw32_HOST_OS+#let CALLCONV = "stdcall"+#else+#let CALLCONV = "ccall"+#endif++-- |+foreign import #{CALLCONV} "HsMySQL.h mysql_init"+ mysql_init :: MYSQL -> IO MYSQL++foreign import #{CALLCONV} "HsMySQL.h mysql_real_connect"+ mysql_real_connect :: MYSQL -> CString -> CString -> CString -> CString -> CInt -> CString -> CInt -> IO MYSQL++foreign import #{CALLCONV} "HsMySQL.h mysql_close"+ mysql_close :: MYSQL -> IO ()++foreign import #{CALLCONV} "HsMySQL.h mysql_errno"+ mysql_errno :: MYSQL -> IO CInt++foreign import #{CALLCONV} "HsMySQL.h mysql_error"+ mysql_error :: MYSQL -> IO CString++foreign import #{CALLCONV} "HsMySQL.h mysql_query"+ mysql_query :: MYSQL -> CString -> IO CInt++foreign import #{CALLCONV} "HsMySQL.h mysql_use_result"+ mysql_use_result :: MYSQL -> IO MYSQL_RES++foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_field"+ mysql_fetch_field :: MYSQL_RES -> IO MYSQL_FIELD++foreign import #{CALLCONV} "HsMySQL.h mysql_free_result"+ mysql_free_result :: MYSQL_RES -> IO ()++foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_row"+ mysql_fetch_row :: MYSQL_RES -> IO MYSQL_ROW++foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_lengths"+ mysql_fetch_lengths :: MYSQL_RES -> IO MYSQL_LENGTHS++foreign import #{CALLCONV} "HsMySQL.h mysql_list_tables"+ mysql_list_tables :: MYSQL -> CString -> IO MYSQL_RES++foreign import #{CALLCONV} "HsMySQL.h mysql_list_fields"+ mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES++foreign import #{CALLCONV} "HsMySQL.h mysql_next_result"+ mysql_next_result :: MYSQL -> IO CInt++-- |+withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement+withStatement conn pMYSQL pRes = do+ currRow <- newMVar (nullPtr, nullPtr)+ refFalse <- newMVar False+ if (pRes == nullPtr)+ then do+ errno <- mysql_errno pMYSQL+ when (errno /= 0) (handleSqlError pMYSQL)+ return Statement { stmtConn = conn+ , stmtClose = return ()+ , stmtFetch = fetch pRes currRow+ , stmtGetCol = getColValue currRow+ , stmtFields = []+ , stmtClosed = refFalse }+ else do+ fieldDefs <- getFieldDefs pRes+ return Statement { stmtConn = conn+ , stmtClose = mysql_free_result pRes+ , stmtFetch = fetch pRes currRow+ , stmtGetCol = getColValue currRow+ , stmtFields = fieldDefs+ , stmtClosed = refFalse }++-- |+getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) + -> Int + -> FieldDef + -> (FieldDef -> CString -> Int -> IO a) + -> IO a+getColValue currRow colNumber fieldDef f = do+ (row, lengths) <- readMVar currRow+ pValue <- peekElemOff row colNumber+ len <- fmap fromIntegral (peekElemOff lengths colNumber)+ f fieldDef pValue len++-- |+getFieldDefs pRes = do+ pField <- mysql_fetch_field pRes+ if pField == nullPtr+ then return []+ else do+ name <- (#peek MYSQL_FIELD, name) pField >>= peekCString+ dataType <- (#peek MYSQL_FIELD, type) pField+ columnSize <- (#peek MYSQL_FIELD, length) pField+ flags <- (#peek MYSQL_FIELD, flags) pField+ decimalDigits <- (#peek MYSQL_FIELD, decimals) pField+ let sqlType = mkSqlType dataType columnSize decimalDigits+ defs <- getFieldDefs pRes+ return ( (name,sqlType,((flags :: Int) .&. (#const NOT_NULL_FLAG)) == 0)+ : defs )++-- |+fetch :: MYSQL_RES + -> MVar (MYSQL_ROW, MYSQL_LENGTHS) + -> IO Bool+fetch pRes currRow+ | pRes == nullPtr = return False+ | otherwise = modifyMVar currRow $ \(pRow, pLengths) -> do+ pRow <- mysql_fetch_row pRes+ pLengths <- mysql_fetch_lengths pRes+ return ((pRow, pLengths), pRow /= nullPtr)++-- |+mysqlDefaultConnectFlags:: CInt+mysqlDefaultConnectFlags = #const MYSQL_DEFAULT_CONNECT_FLAGS++------------------------------------------------------------------------------+-- routines for handling exceptions+------------------------------------------------------------------------------+-- |+handleSqlError :: MYSQL -> IO a+handleSqlError pMYSQL = do+ errno <- mysql_errno pMYSQL+ errMsg <- mysql_error pMYSQL >>= peekCString+ throw (SqlError "" (fromIntegral errno) errMsg)+
+ DB/HSQL/MySQL/Type.hsc view
@@ -0,0 +1,41 @@+module DB.HSQL.MySQL.Type where++import Foreign(Ptr)+import Foreign.C(CString,CULong)++import Database.HSQL.Types++#include <HsMySQL.h>++-- |+type MYSQL = Ptr ()++type MYSQL_RES = Ptr ()++type MYSQL_FIELD = Ptr ()++type MYSQL_ROW = Ptr CString++type MYSQL_LENGTHS = Ptr CULong++-- |+mkSqlType :: Int -> Int -> Int -> SqlType+mkSqlType (#const FIELD_TYPE_STRING) size _ = SqlChar size+mkSqlType (#const FIELD_TYPE_VAR_STRING) size _ = SqlVarChar size+mkSqlType (#const FIELD_TYPE_DECIMAL) size prec = SqlNumeric size prec+mkSqlType (#const FIELD_TYPE_SHORT) _ _ = SqlSmallInt+mkSqlType (#const FIELD_TYPE_INT24) _ _ = SqlMedInt+mkSqlType (#const FIELD_TYPE_LONG) _ _ = SqlInteger+mkSqlType (#const FIELD_TYPE_FLOAT) _ _ = SqlReal+mkSqlType (#const FIELD_TYPE_DOUBLE) _ _ = SqlDouble+mkSqlType (#const FIELD_TYPE_TINY) _ _ = SqlTinyInt+mkSqlType (#const FIELD_TYPE_LONGLONG) _ _ = SqlBigInt+mkSqlType (#const FIELD_TYPE_DATE) _ _ = SqlDate+mkSqlType (#const FIELD_TYPE_TIME) _ _ = SqlTime+mkSqlType (#const FIELD_TYPE_TIMESTAMP) _ _ = SqlTimeStamp+mkSqlType (#const FIELD_TYPE_DATETIME) _ _ = SqlDateTime+mkSqlType (#const FIELD_TYPE_YEAR) _ _ = SqlYear+mkSqlType (#const FIELD_TYPE_BLOB) _ _ = SqlBLOB+mkSqlType (#const FIELD_TYPE_SET) _ _ = SqlSET+mkSqlType (#const FIELD_TYPE_ENUM) _ _ = SqlENUM+mkSqlType tp _ _ = SqlUnknown tp
+ Database/HSQL/MySQL.hs view
@@ -0,0 +1,106 @@+{-| Module : Database.HSQL.MySQL+ Copyright : (c) Krasimir Angelov 2003+ License : BSD-style++ Maintainer : ka2_mail@yahoo.com+ Stability : provisional+ Portability : portable++ The module provides interface to MySQL database+-}+module Database.HSQL.MySQL(connect,module Database.HSQL) where++import Database.HSQL+import Database.HSQL.Types(Connection(..),Statement(stmtGetCol),FieldDef+ ,SqlType(SqlVarChar),fromSqlCStringLen)+import Foreign(nullPtr,free)+import Foreign.C(newCString,withCString)+import Control.Monad(when)+import Control.Concurrent.MVar(newMVar)++import DB.HSQL.MySQL.Type(MYSQL,MYSQL_RES)+import DB.HSQL.MySQL.Functions(handleSqlError,withStatement,mysql_query+ ,mysql_close,mysql_use_result,mysql_next_result+ ,mysql_list_fields,mysql_list_tables+ ,mysql_init,mysql_real_connect+ ,mysqlDefaultConnectFlags)++------------------------------------------------------------------------------+-- Connect/Disconnect+------------------------------------------------------------------------------+-- | Makes a new connection to the database server.+connect :: String -- ^ Server name+ -> String -- ^ Database name+ -> String -- ^ User identifier+ -> String -- ^ Authentication string (password)+ -> IO Connection+connect server database user authentication = do+ pMYSQL <- mysql_init nullPtr+ pServer <- newCString server+ pDatabase <- newCString database+ pUser <- newCString user+ pAuthentication <- newCString authentication+ res <- mysql_real_connect pMYSQL pServer pUser pAuthentication pDatabase 0 nullPtr mysqlDefaultConnectFlags+ free pServer+ free pDatabase+ free pUser+ free pAuthentication+ when (res == nullPtr) (handleSqlError pMYSQL)+ refFalse <- newMVar False+ let connection = Connection+ { connDisconnect = mysql_close pMYSQL+ , connExecute = mysqlExecute pMYSQL+ , connQuery = mysqlQuery connection pMYSQL+ , connTables = mysqlTables connection pMYSQL+ , connDescribe = mysqlDescribe connection pMYSQL+ , connBeginTransaction = mysqlExecute pMYSQL "begin"+ , connCommitTransaction = mysqlExecute pMYSQL "commit"+ , connRollbackTransaction = mysqlExecute pMYSQL "rollback"+ , connClosed = refFalse }+ return connection++-- |+mysqlQuery :: Connection -> MYSQL -> String -> IO Statement+mysqlQuery conn pMYSQL query = do+ res <- withCString query (mysql_query pMYSQL)+ when (res /= 0) (handleSqlError pMYSQL)+ pRes <- getFirstResult pMYSQL+ withStatement conn pMYSQL pRes+ where+ getFirstResult :: MYSQL -> IO MYSQL_RES+ getFirstResult pMYSQL = do+ pRes <- mysql_use_result pMYSQL+ if pRes == nullPtr+ then do+ res <- mysql_next_result pMYSQL+ if res == 0+ then getFirstResult pMYSQL+ else return nullPtr+ else return pRes+++-- |+mysqlDescribe :: Connection -> MYSQL -> String -> IO [FieldDef]+mysqlDescribe conn pMYSQL table = do+ pRes <- withCString table (\table -> mysql_list_fields pMYSQL table nullPtr)+ stmt <- withStatement conn pMYSQL pRes+ return (getFieldsTypes stmt)+++-- |+mysqlTables :: Connection -> MYSQL -> IO [String]+mysqlTables conn pMYSQL = do+ pRes <- mysql_list_tables pMYSQL nullPtr+ stmt <- withStatement conn pMYSQL pRes+ -- SQLTables returns:+ -- Column name # Type+ -- Tables_in_xx 0 VARCHAR+ collectRows (\stmt -> do+ mb_v <- stmtGetCol stmt 0 ("Tables", SqlVarChar 0, False) fromSqlCStringLen+ return (case mb_v of { Nothing -> ""; Just a -> a })) stmt++-- |+mysqlExecute :: MYSQL -> String -> IO ()+mysqlExecute pMYSQL query = do+ res <- withCString query (mysql_query pMYSQL)+ when (res /= 0) (handleSqlError pMYSQL)
− Database/HSQL/MySQL.hsc
@@ -1,223 +0,0 @@-------------------------------------------------------------------------------------------{-| Module : Database.HSQL.MySQL- Copyright : (c) Krasimir Angelov 2003- License : BSD-style-- Maintainer : ka2_mail@yahoo.com- Stability : provisional- Portability : portable-- The module provides interface to MySQL database--}--------------------------------------------------------------------------------------------module Database.HSQL.MySQL(connect, module Database.HSQL) where--import Database.HSQL-import Database.HSQL.Types-import Data.Dynamic-import Data.Bits-import Data.Char-import Foreign-import Foreign.C-import Control.Monad(when,unless)-import Control.Exception (throwDyn, finally)-import Control.Concurrent.MVar-import System.Time-import System.IO.Unsafe-import Text.ParserCombinators.ReadP-import Text.Read--#include <HsMySQL.h>--type MYSQL = Ptr ()-type MYSQL_RES = Ptr ()-type MYSQL_FIELD = Ptr ()-type MYSQL_ROW = Ptr CString-type MYSQL_LENGTHS = Ptr CULong--#ifdef mingw32_HOST_OS-#let CALLCONV = "stdcall"-#else-#let CALLCONV = "ccall"-#endif--foreign import #{CALLCONV} "HsMySQL.h mysql_init" mysql_init :: MYSQL -> IO MYSQL-foreign import #{CALLCONV} "HsMySQL.h mysql_real_connect" mysql_real_connect :: MYSQL -> CString -> CString -> CString -> CString -> CInt -> CString -> CInt -> IO MYSQL-foreign import #{CALLCONV} "HsMySQL.h mysql_close" mysql_close :: MYSQL -> IO ()-foreign import #{CALLCONV} "HsMySQL.h mysql_errno" mysql_errno :: MYSQL -> IO CInt-foreign import #{CALLCONV} "HsMySQL.h mysql_error" mysql_error :: MYSQL -> IO CString-foreign import #{CALLCONV} "HsMySQL.h mysql_query" mysql_query :: MYSQL -> CString -> IO CInt-foreign import #{CALLCONV} "HsMySQL.h mysql_use_result" mysql_use_result :: MYSQL -> IO MYSQL_RES-foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_field" mysql_fetch_field :: MYSQL_RES -> IO MYSQL_FIELD-foreign import #{CALLCONV} "HsMySQL.h mysql_free_result" mysql_free_result :: MYSQL_RES -> IO ()-foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_row" mysql_fetch_row :: MYSQL_RES -> IO MYSQL_ROW-foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_lengths" mysql_fetch_lengths :: MYSQL_RES -> IO MYSQL_LENGTHS-foreign import #{CALLCONV} "HsMySQL.h mysql_list_tables" mysql_list_tables :: MYSQL -> CString -> IO MYSQL_RES-foreign import #{CALLCONV} "HsMySQL.h mysql_list_fields" mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES-foreign import #{CALLCONV} "HsMySQL.h mysql_next_result" mysql_next_result :: MYSQL -> IO CInt------------------------------------------------------------------------------------------------ routines for handling exceptions--------------------------------------------------------------------------------------------handleSqlError :: MYSQL -> IO a-handleSqlError pMYSQL = do- errno <- mysql_errno pMYSQL- errMsg <- mysql_error pMYSQL >>= peekCString- throwDyn (SqlError "" (fromIntegral errno) errMsg)---------------------------------------------------------------------------------------------- Connect/Disconnect---------------------------------------------------------------------------------------------- | Makes a new connection to the database server.-connect :: String -- ^ Server name- -> String -- ^ Database name- -> String -- ^ User identifier- -> String -- ^ Authentication string (password)- -> IO Connection-connect server database user authentication = do- pMYSQL <- mysql_init nullPtr- pServer <- newCString server- pDatabase <- newCString database- pUser <- newCString user- pAuthentication <- newCString authentication- res <- mysql_real_connect pMYSQL pServer pUser pAuthentication pDatabase 0 nullPtr (#const MYSQL_DEFAULT_CONNECT_FLAGS)- free pServer- free pDatabase- free pUser- free pAuthentication- when (res == nullPtr) (handleSqlError pMYSQL)- refFalse <- newMVar False- let connection = Connection- { connDisconnect = mysql_close pMYSQL- , connExecute = execute pMYSQL- , connQuery = query connection pMYSQL- , connTables = tables connection pMYSQL- , connDescribe = describe connection pMYSQL- , connBeginTransaction = execute pMYSQL "begin"- , connCommitTransaction = execute pMYSQL "commit"- , connRollbackTransaction = execute pMYSQL "rollback"- , connClosed = refFalse- }- return connection- where- execute :: MYSQL -> String -> IO ()- execute pMYSQL query = do- res <- withCString query (mysql_query pMYSQL)- when (res /= 0) (handleSqlError pMYSQL)-- withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement- withStatement conn pMYSQL pRes = do- currRow <- newMVar (nullPtr, nullPtr)- refFalse <- newMVar False- if (pRes == nullPtr)- then do- errno <- mysql_errno pMYSQL- when (errno /= 0) (handleSqlError pMYSQL)- return (Statement- { stmtConn = conn- , stmtClose = return ()- , stmtFetch = fetch pRes currRow- , stmtGetCol = getColValue currRow- , stmtFields = []- , stmtClosed = refFalse- })- else do- fieldDefs <- getFieldDefs pRes- return (Statement- { stmtConn = conn- , stmtClose = mysql_free_result pRes- , stmtFetch = fetch pRes currRow- , stmtGetCol = getColValue currRow- , stmtFields = fieldDefs- , stmtClosed = refFalse- })- where- getFieldDefs pRes = do- pField <- mysql_fetch_field pRes- if pField == nullPtr- then return []- else do- name <- (#peek MYSQL_FIELD, name) pField >>= peekCString- dataType <- (#peek MYSQL_FIELD, type) pField- columnSize <- (#peek MYSQL_FIELD, length) pField- flags <- (#peek MYSQL_FIELD, flags) pField- decimalDigits <- (#peek MYSQL_FIELD, decimals) pField- let sqlType = mkSqlType dataType columnSize decimalDigits- defs <- getFieldDefs pRes- return ((name,sqlType,((flags :: Int) .&. (#const NOT_NULL_FLAG)) == 0):defs)-- mkSqlType :: Int -> Int -> Int -> SqlType- mkSqlType (#const FIELD_TYPE_STRING) size _ = SqlChar size- mkSqlType (#const FIELD_TYPE_VAR_STRING) size _ = SqlVarChar size- mkSqlType (#const FIELD_TYPE_DECIMAL) size prec = SqlNumeric size prec- mkSqlType (#const FIELD_TYPE_SHORT) _ _ = SqlSmallInt- mkSqlType (#const FIELD_TYPE_INT24) _ _ = SqlMedInt- mkSqlType (#const FIELD_TYPE_LONG) _ _ = SqlInteger- mkSqlType (#const FIELD_TYPE_FLOAT) _ _ = SqlReal- mkSqlType (#const FIELD_TYPE_DOUBLE) _ _ = SqlDouble- mkSqlType (#const FIELD_TYPE_TINY) _ _ = SqlTinyInt- mkSqlType (#const FIELD_TYPE_LONGLONG) _ _ = SqlBigInt- mkSqlType (#const FIELD_TYPE_DATE) _ _ = SqlDate- mkSqlType (#const FIELD_TYPE_TIME) _ _ = SqlTime- mkSqlType (#const FIELD_TYPE_TIMESTAMP) _ _ = SqlTimeStamp- mkSqlType (#const FIELD_TYPE_DATETIME) _ _ = SqlDateTime- mkSqlType (#const FIELD_TYPE_YEAR) _ _ = SqlYear- mkSqlType (#const FIELD_TYPE_BLOB) _ _ = SqlBLOB- mkSqlType (#const FIELD_TYPE_SET) _ _ = SqlSET- mkSqlType (#const FIELD_TYPE_ENUM) _ _ = SqlENUM- mkSqlType tp _ _ = SqlUnknown tp-- query :: Connection -> MYSQL -> String -> IO Statement- query conn pMYSQL query = do- res <- withCString query (mysql_query pMYSQL)- when (res /= 0) (handleSqlError pMYSQL)- pRes <- getFirstResult pMYSQL- withStatement conn pMYSQL pRes- where- getFirstResult :: MYSQL -> IO MYSQL_RES- getFirstResult pMYSQL = do- pRes <- mysql_use_result pMYSQL- if pRes == nullPtr- then do- res <- mysql_next_result pMYSQL- if res == 0- then getFirstResult pMYSQL- else return nullPtr- else return pRes-- fetch :: MYSQL_RES -> MVar (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool- fetch pRes currRow- | pRes == nullPtr = return False- | otherwise = modifyMVar currRow $ \(pRow, pLengths) -> do- pRow <- mysql_fetch_row pRes- pLengths <- mysql_fetch_lengths pRes- return ((pRow, pLengths), pRow /= nullPtr)-- getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a- getColValue currRow colNumber fieldDef f = do- (row, lengths) <- readMVar currRow- pValue <- peekElemOff row colNumber- len <- fmap fromIntegral (peekElemOff lengths colNumber)- f fieldDef pValue len-- tables :: Connection -> MYSQL -> IO [String]- tables conn pMYSQL = do- pRes <- mysql_list_tables pMYSQL nullPtr- stmt <- withStatement conn pMYSQL pRes- -- SQLTables returns:- -- Column name # Type- -- Tables_in_xx 0 VARCHAR- collectRows (\stmt -> do- mb_v <- stmtGetCol stmt 0 ("Tables", SqlVarChar 0, False) fromSqlCStringLen- return (case mb_v of { Nothing -> ""; Just a -> a })) stmt-- describe :: Connection -> MYSQL -> String -> IO [FieldDef]- describe conn pMYSQL table = do- pRes <- withCString table (\table -> mysql_list_fields pMYSQL table nullPtr)- stmt <- withStatement conn pMYSQL pRes- return (getFieldsTypes stmt)
LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2009, Krasimir Angelov <kr.angelov@gmail.com>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++* Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++* Neither the name of the author nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
hsql-mysql.cabal view
@@ -1,19 +1,22 @@ name: hsql-mysql -version: 1.7.1 +version: 1.8.1 license: BSD3 author: Krasimir Angelov <kr.a...@gmail.com> category: Database description: MySQL driver for HSQL. synopsis: MySQL driver for HSQL. ghc-options: -O2 -build-depends: base==3.*, hsql, Cabal, old-time +build-depends: base >=4 && < 5, hsql >= 1.8, Cabal extensions: ForeignFunctionInterface, CPP include-dirs: Database/HSQL, /usr/include/mysql build-type: Simple extra-source-files: Database/HSQL/HsMySQL.h extra-libraries: mysqlclient -extra-lib-dirs: /usr/lib/mysql -exposed-modules: Database.HSQL.MySQL +extra-lib-dirs: /usr/lib,/usr/lib/mysql +exposed-modules: + Database.HSQL.MySQL+ DB.HSQL.MySQL.Type+ DB.HSQL.MySQL.Functions maintainer: Chris Done <chrisdone@gmail.com> license-file: LICENSE cabal-version: >= 1.6