packages feed

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 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