hsql-mysql-1.8.2/0000755000175000017500000000000011735633636011113 5ustar iihsql-mysql-1.8.2/ChangeLog0000644000175000017500000000012111331270607012642 0ustar ii2010-1-31 1.8.1: uses updated exception handling of hsql-1.8.1; refactorings hsql-mysql-1.8.2/DB/0000755000175000017500000000000011331107365011363 5ustar iihsql-mysql-1.8.2/DB/HSQL/0000755000175000017500000000000011331107411012122 5ustar iihsql-mysql-1.8.2/DB/HSQL/MySQL/0000755000175000017500000000000011735605005013101 5ustar iihsql-mysql-1.8.2/DB/HSQL/MySQL/Functions.hsc0000644000175000017500000001103111735604712015550 0ustar iimodule 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(ColDef,Statement(..),Connection(..),SqlError(..)) import DB.HSQL.MySQL.Type(MYSQL,MYSQL_RES,MYSQL_FIELD,MYSQL_ROW,MYSQL_LENGTHS ,mkSqlType) #include #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 -> ColDef -> (ColDef -> 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) hsql-mysql-1.8.2/DB/HSQL/MySQL/Type.hsc0000644000175000017500000000300411331260031014502 0ustar iimodule DB.HSQL.MySQL.Type where import Foreign(Ptr) import Foreign.C(CString,CULong) import Database.HSQL.Types #include -- | 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 hsql-mysql-1.8.2/LICENSE0000644000175000017500000000274311145152653012114 0ustar iiCopyright (c) 2009, Krasimir Angelov 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-1.8.2/Database/0000755000175000017500000000000011132667766012621 5ustar iihsql-mysql-1.8.2/Database/HSQL/0000755000175000017500000000000011735604777013372 5ustar iihsql-mysql-1.8.2/Database/HSQL/MySQL.hs0000644000175000017500000000735011735604753014672 0ustar ii{-| 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),ColDef ,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 [ColDef] 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) hsql-mysql-1.8.2/Database/HSQL/HsMySQL.h0000644000175000017500000000040111132667766014774 0ustar ii#ifndef HsMySQL #define HsMySQL #ifdef mingw32_HOST_OS #include #endif #include #ifdef CLIENT_MULTI_STATEMENTS #define MYSQL_DEFAULT_CONNECT_FLAGS CLIENT_MULTI_STATEMENTS #else #define MYSQL_DEFAULT_CONNECT_FLAGS 0 #endif #endif hsql-mysql-1.8.2/Setup.lhs0000644000175000017500000000013311132667766012722 0ustar ii#!/usr/bin/runghc \begin{code} import Distribution.Simple main = defaultMain \end{code} hsql-mysql-1.8.2/hsql-mysql.cabal0000644000175000017500000000200011735633517014177 0ustar iiName: hsql-mysql Version: 1.8.2 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 License-File: LICENSE Author: Krasimir Angelov Maintainer: Chris Done Category: Database Synopsis: MySQL driver for HSQL. Description: MySQL driver for HSQL. Library { Build-Depends: base >=4 && < 5, hsql >= 1.8.2, Cabal Exposed-Modules: Database.HSQL.MySQL DB.HSQL.MySQL.Type DB.HSQL.MySQL.Functions Exposed: True Other-Modules: Hs-Source-Dirs: . Default-Extensions: Other-Extensions: CPP, DeriveDataTypeable, FlexibleInstances, ForeignFunctionInterface, RankNTypes, ScopedTypeVariables Buildable: True GHC-Options: -O2 Includes: Database/HSQL/HsMySQL.h Install-Includes: Include-Dirs: Database/HSQL, /usr/include/mysql C-Sources: Extra-Libraries: mysqlclient Extra-Lib-Dirs: /usr/lib,/usr/lib/mysql CC-Options: LD-Options: PkgConfig-Depends: Frameworks: Default-Language: Haskell2010 }