htoolkit-cvs Mailing List for Haskell Toolkit (Page 15)

Status: Alpha

Brought to you by: frederik_eaton, kr_angelov

htoolkit-cvs — HToolkit CVS commit messages

You can subscribe to this list here.

2003	Jan (30)	Feb (20)	Mar (151)	Apr (86)	May (23)	Jun (25)	Jul (107)	Aug (141)	Sep (55)	Oct (85)	Nov (65)	Dec (2)
2004	Jan (22)	Feb (18)	Mar (3)	Apr (16)	May (69)	Jun (3)	Jul (1)	Aug (3)	Sep (1)	Oct	Nov (6)	Dec (1)
2005	Jan (2)	Feb (16)	Mar	Apr	May	Jun (47)	Jul (1)	Aug	Sep (6)	Oct (4)	Nov	Dec (34)
2006	Jan (39)	Feb	Mar (2)	Apr	May	Jun (1)	Jul	Aug	Sep (5)	Oct	Nov (4)	Dec
2007	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec (1)
2008	Jan	Feb	Mar (26)	Apr (1)	May (1)	Jun	Jul (5)	Aug (2)	Sep (8)	Oct (8)	Nov (22)	Dec (30)
2009	Jan (10)	Feb (13)	Mar (14)	Apr (14)	May (32)	Jun (25)	Jul (36)	Aug (10)	Sep (2)	Oct	Nov	Dec (10)
2010	Jan (9)	Feb (4)	Mar (2)	Apr (1)	May (2)	Jun (2)	Jul (1)	Aug (4)	Sep	Oct (1)	Nov	Dec

Flat | Threaded

<< < 1 .. 13 14 15 16 17 .. 47 > >> (Page 15 of 47)

[htoolkit-cvs] HSQL configure.ac,1.12,1.13

From: <kr_...@us...> - 2004-02-15 10:55:50

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28113

Modified Files:
	configure.ac 
Log Message:
Applied patch from Conny Andersson


Index: configure.ac
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/configure.ac,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** configure.ac	27 Jan 2004 21:01:58 -0000	1.12
--- configure.ac	15 Feb 2004 10:48:41 -0000	1.13
***************
*** 368,369 ****
--- 368,379 ----
  echo " - build/Database/HSQL"
  mkdir -p build/Database/HSQL
+ 
+ echo
+ echo "Backends"
+ echo "--------"
+ echo
+ echo "MySQL:       $WithMySQL"
+ echo "PostgreSQL:  $WithPostgreSQL"
+ echo "SQLite:      $WithSQLite"
+ echo "ODBC:        $WithODBC"
+ echo

[htoolkit-cvs] HSQL/src HSQL.hsc,1.7,1.8

From: <kr_...@us...> - 2004-02-11 19:09:59

Update of /cvsroot/htoolkit/HSQL/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29280/src

Modified Files:
	HSQL.hsc 
Log Message:
Fix calculation of ClockTime for SqlTimeTZ type


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL.hsc,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** HSQL.hsc	10 Feb 2004 11:30:52 -0000	1.7
--- HSQL.hsc	11 Feb 2004 19:05:41 -0000	1.8
***************
*** 309,313 ****
  				(char '.' >> readDecP) `mplus` (return 0)
  				tz <- parseTZ
! 				return (mkClockTime 1970 0 1 hour minutes seconds (tz*3600))
  
  	fromSqlValue SqlTime s = f_read getTime s
--- 309,313 ----
  				(char '.' >> readDecP) `mplus` (return 0)
  				tz <- parseTZ
! 				return (mkClockTime 1970 1 1 hour minutes seconds (tz*3600))
  
  	fromSqlValue SqlTime s = f_read getTime s

[htoolkit-cvs] HSQL Makefile,1.11,1.12

From: <kr_...@us...> - 2004-02-11 19:09:59

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29280

Modified Files:
	Makefile 
Log Message:
Fix calculation of ClockTime for SqlTimeTZ type


Index: Makefile
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/Makefile,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Makefile	26 Jan 2004 23:36:18 -0000	1.11
--- Makefile	11 Feb 2004 19:05:41 -0000	1.12
***************
*** 139,143 ****
  docs : $(HS_PPS)
  	mkdir -p $(DOCDIR)
! 	$(HADDOCK) -h -o $(DOCDIR) $(HS_PPS)
  
  
--- 139,143 ----
  docs : $(HS_PPS)
  	mkdir -p $(DOCDIR)
! 	$(HADDOCK) -h -o $(DOCDIR) $(HS_PPS) -ihttp://www.haskell.org/ghc/docs/latest/html/libraries/base,/usr/share/ghc-6.2/html/libraries/base/base.haddock

[htoolkit-cvs] HSQL/src/HSQL MySQL.hsc,1.3,1.4 ODBC.hsc,1.6,1.7 PostgreSQL.hsc,1.8,1.9 SQLite.hsc,1.1,1.2 Types.hs,1.4,1.5

From: <kr_...@us...> - 2004-02-10 11:34:09

Update of /cvsroot/htoolkit/HSQL/src/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22228/src/HSQL

Modified Files:
	MySQL.hsc ODBC.hsc PostgreSQL.hsc SQLite.hsc Types.hs 
Log Message:
All functions in the HSQL API are now thread safe


Index: MySQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/MySQL.hsc,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** MySQL.hsc	23 Jan 2004 08:54:13 -0000	1.3
--- MySQL.hsc	10 Feb 2004 11:30:52 -0000	1.4
***************
*** 20,24 ****
  import Data.Dynamic
  import Data.Bits
- import Data.IORef
  import Data.Char
  import Foreign
--- 20,23 ----
***************
*** 26,29 ****
--- 25,29 ----
  import Control.Monad(when,unless)
  import Control.Exception (throwDyn, finally)
+ import Control.Concurrent.MVar
  import System.Time
  import System.IO.Unsafe
***************
*** 88,92 ****
  	free pAuthentication
  	when (res == nullPtr) (handleSqlError pMYSQL)
! 	refFalse <- newIORef False
  	let connection = Connection
  		{ connDisconnect = mysql_close pMYSQL
--- 88,92 ----
  	free pAuthentication
  	when (res == nullPtr) (handleSqlError pMYSQL)
! 	refFalse <- newMVar False
  	let connection = Connection
  		{ connDisconnect = mysql_close pMYSQL
***************
*** 109,114 ****
  		withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
  		withStatement conn pMYSQL pRes = do
! 			currRow  <- newIORef (nullPtr, nullPtr)
! 			refFalse <- newIORef False
  			if (pRes == nullPtr)
  			  then do
--- 109,114 ----
  		withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
  		withStatement conn pMYSQL pRes = do
! 			currRow  <- newMVar (nullPtr, nullPtr)
! 			refFalse <- newMVar False
  			if (pRes == nullPtr)
  			  then do
***************
*** 176,191 ****
  			withStatement conn pMYSQL pRes
  
! 		fetch :: MYSQL_RES -> IORef (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool
  		fetch pRes currRow
  			| pRes == nullPtr = return False
! 			| otherwise = do
  				pRow <- mysql_fetch_row pRes
  				pLengths <- mysql_fetch_lengths pRes
! 				writeIORef currRow (pRow, pLengths)
! 				return (pRow /= nullPtr)
  
! 		getColValue :: IORef (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue currRow colNumber (name,sqlType,nullable) f = do
! 			(row, lengths) <- readIORef currRow
  			pValue <- peekElemOff row colNumber
  			len <- fmap fromIntegral (peekElemOff lengths colNumber)
--- 176,190 ----
  			withStatement conn pMYSQL 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 -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue currRow colNumber (name,sqlType,nullable) f = do
! 			(row, lengths) <- readMVar currRow
  			pValue <- peekElemOff row colNumber
  			len <- fmap fromIntegral (peekElemOff lengths colNumber)

Index: ODBC.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/ODBC.hsc,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** ODBC.hsc	9 Feb 2004 06:33:10 -0000	1.6
--- ODBC.hsc	10 Feb 2004 11:30:52 -0000	1.7
***************
*** 18,22 ****
  import Data.Word(Word32, Word16)
  import Data.Int(Int32, Int16)
- import Data.IORef
  import Data.Maybe
  import Foreign
--- 18,21 ----
***************
*** 24,27 ****
--- 23,27 ----
  import Control.Monad(unless)
  import Control.Exception(throwDyn)
+ import Control.Concurrent.MVar
  import System.IO.Unsafe
  import System.Time
***************
*** 145,149 ****
  	free pAuthentication
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
! 	refFalse <- newIORef False
  	let connection = (Connection
  			{ connDisconnect = disconnect hDBC
--- 145,149 ----
  	free pAuthentication
  	handleSqlResult (#const SQL_HANDLE_DBC) hDBC res
! 	refFalse <- newMVar False
  	let connection = (Connection
  			{ connDisconnect = disconnect hDBC
***************
*** 199,203 ****
  			free pFIELD
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
! 			refFalse <- newIORef False
  			let statement = Statement
  				{ stmtConn   = connection
--- 199,203 ----
  			free pFIELD
  			buffer <- mallocBytes (fromIntegral stmtBufferSize)
! 			refFalse <- newMVar False
  			let statement = Statement
  				{ stmtConn   = connection

Index: PostgreSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/PostgreSQL.hsc,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** PostgreSQL.hsc	9 Feb 2004 21:49:43 -0000	1.8
--- PostgreSQL.hsc	10 Feb 2004 11:30:52 -0000	1.9
***************
*** 17,21 ****
  import Database.HSQL.Types
  import Data.Dynamic
- import Data.IORef
  import Data.Char
  import Foreign
--- 17,20 ----
***************
*** 23,26 ****
--- 22,26 ----
  import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..))
  import Control.Monad(when,unless,mplus)
+ import Control.Concurrent.MVar
  import System.Time
  import System.IO.Unsafe
***************
*** 83,87 ****
  		pqFinish pConn
  		throwDyn (SqlError {seState="C", seNativeError=fromIntegral status, seErrorMsg=errMsg}))
! 	refFalse <- newIORef False
  	let connection = Connection
  		{ connDisconnect = pqFinish pConn
--- 83,87 ----
  		pqFinish pConn
  		throwDyn (SqlError {seState="C", seNativeError=fromIntegral status, seErrorMsg=errMsg}))
! 	refFalse <- newMVar False
  	let connection = Connection
  		{ connDisconnect = pqFinish pConn
***************
*** 121,126 ****
  			defs <- if status ==  (#const PGRES_TUPLES_OK) then pgNFields pRes >>= getFieldDefs pRes 0 else return []
  			countTuples <- pqNTuples pRes;
! 			tupleIndex <- newIORef (-1)
! 			refFalse <- newIORef False
  			return (Statement
  			              { stmtConn   = conn
--- 121,126 ----
  			defs <- if status ==  (#const PGRES_TUPLES_OK) then pgNFields pRes >>= getFieldDefs pRes 0 else return []
  			countTuples <- pqNTuples pRes;
! 			tupleIndex <- newMVar (-1)
! 			refFalse <- newMVar False
  			return (Statement
  			              { stmtConn   = conn
***************
*** 203,217 ****
  					return (column_name, sqlType, not notnull)
  
! 		fetch :: IORef Int -> Int -> IO Bool
! 		fetch tupleIndex countTuples= do
! 			index <- readIORef tupleIndex
! 			let index' = index+1
! 			if (index' >= countTuples)
! 			  then return False
! 			  else writeIORef tupleIndex index' >> return True
  
! 		getColValue :: PGresult -> IORef Int -> Int -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue pRes tupleIndex countTuples colNumber  (name,sqlType,nullable) f = do
! 			index <- readIORef tupleIndex
  			when (index >= countTuples) (throwDyn SqlNoData)
  			isnull <- pqGetisnull pRes index colNumber
--- 203,213 ----
  					return (column_name, sqlType, not notnull)
  
! 		fetch :: MVar Int -> Int -> IO Bool
! 		fetch tupleIndex countTuples =
! 			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples-1))
  
! 		getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		getColValue pRes tupleIndex countTuples colNumber  (name,sqlType,nullable) f = do
! 			index <- readMVar tupleIndex
  			when (index >= countTuples) (throwDyn SqlNoData)
  			isnull <- pqGetisnull pRes index colNumber

Index: SQLite.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/SQLite.hsc,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** SQLite.hsc	26 Jan 2004 23:36:19 -0000	1.1
--- SQLite.hsc	10 Feb 2004 11:30:52 -0000	1.2
***************
*** 16,20 ****
  import Database.HSQL
  import Database.HSQL.Types
- import Data.IORef
  import Foreign
  import Foreign.C
--- 16,19 ----
***************
*** 22,25 ****
--- 21,25 ----
  import Control.Monad(when)
  import Control.Exception(throwDyn)
+ import Control.Concurrent.MVar
  
  #include <fcntl.h>
***************
*** 68,72 ****
  			            , seErrorMsg = msg
  			            })
! 		refFalse <- newIORef False
  		let connection = Connection
  			{ connDisconnect = sqlite_close sqlite
--- 68,72 ----
  			            , seErrorMsg = msg
  			            })
! 		refFalse <- newMVar False
  		let connection = Connection
  			{ connDisconnect = sqlite_close sqlite
***************
*** 108,113 ****
  				columns <- peek pnColumn
  				defs <- getFieldDefs pResult 0 columns
! 				refFalse <- newIORef False
! 				refIndex <- newIORef 0
  				return (Statement
  				              { stmtConn   = connection
--- 108,113 ----
  				columns <- peek pnColumn
  				defs <- getFieldDefs pResult 0 columns
! 				refFalse <- newMVar False
! 				refIndex <- newMVar 0
  				return (Statement
  				              { stmtConn   = connection
***************
*** 142,155 ****
  					return (name, SqlText, notnull=="0")
  
! 		fetch :: IORef Int -> Int -> IO Bool
! 		fetch refIndex countTuples= do
! 			index <- readIORef refIndex
! 			let index' = index+1
! 			if (index' > countTuples)
! 			  then return False
! 			  else writeIORef refIndex index' >> return True
  
  		getColValue pResult refIndex columns rows colNumber  (name,sqlType,nullable) f = do
! 			index <- readIORef refIndex
  			when (index > rows) (throwDyn SqlNoData)
  			pStr <- peekElemOff pResult (columns*index+colNumber)
--- 142,150 ----
  					return (name, SqlText, notnull=="0")
  
! 		fetch tupleIndex countTuples =
! 			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples))
  
  		getColValue pResult refIndex columns rows colNumber  (name,sqlType,nullable) f = do
! 			index <- readMVar refIndex
  			when (index > rows) (throwDyn SqlNoData)
  			pStr <- peekElemOff pResult (columns*index+colNumber)

Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/Types.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Types.hs	23 Jan 2004 08:54:19 -0000	1.4
--- Types.hs	10 Feb 2004 11:30:52 -0000	1.5
***************
*** 2,7 ****
  module Database.HSQL.Types where
  
  import Data.Dynamic
- import Data.IORef
  import Foreign.C
  
--- 2,7 ----
  module Database.HSQL.Types where
  
+ import Control.Concurrent.MVar
  import Data.Dynamic
  import Foreign.C
  
***************
*** 106,110 ****
  		, connCommitTransaction :: IO ()
  		, connRollbackTransaction :: IO ()
! 		, connClosed :: IORef Bool
  		}
  
--- 106,110 ----
  		, connCommitTransaction :: IO ()
  		, connRollbackTransaction :: IO ()
! 		, connClosed :: MVar Bool
  		}
  
***************
*** 117,121 ****
  		, stmtGetCol :: forall a . Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		, stmtFields :: [FieldDef]
! 		, stmtClosed :: IORef Bool
  		}
  
--- 117,121 ----
  		, stmtGetCol :: forall a . Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
  		, stmtFields :: [FieldDef]
! 		, stmtClosed :: MVar Bool
  		}

[htoolkit-cvs] HSQL/src HSQL.hsc,1.6,1.7

From: <kr_...@us...> - 2004-02-10 11:34:09

Update of /cvsroot/htoolkit/HSQL/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22228/src

Modified Files:
	HSQL.hsc 
Log Message:
All functions in the HSQL API are now thread safe


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL.hsc,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** HSQL.hsc	9 Feb 2004 21:49:43 -0000	1.6
--- HSQL.hsc	10 Feb 2004 11:30:52 -0000	1.7
***************
*** 63,71 ****
  import Data.Char
  import Data.Dynamic
- import Data.IORef
  import System.Time
  import System.IO.Unsafe(unsafePerformIO)
  import Control.Monad(when,unless,mplus)
  import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..), finally)
  import Text.ParserCombinators.ReadP
  import Text.Read
--- 63,71 ----
  import Data.Char
  import Data.Dynamic
  import System.Time
  import System.IO.Unsafe(unsafePerformIO)
  import Control.Monad(when,unless,mplus)
  import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..), finally)
+ import Control.Concurrent.MVar
  import Text.ParserCombinators.ReadP
  import Text.Read
***************
*** 89,102 ****
  sqlExceptions e = dynExceptions e >>= fromDynamic
  
! checkHandle :: IORef Bool -> IO ()
! checkHandle ref = do
! 	closed <- readIORef ref
! 	when closed (throwDyn SqlClosedHandle)
  
! closeHandle :: (a -> IORef Bool) -> (a -> IO ()) -> a -> IO ()
! closeHandle getRef action handle = do
! 	closed <- readIORef (getRef handle)
! 	unless closed (action handle)
! 	writeIORef (getRef handle) True
  
  -----------------------------------------------------------------------------------------
--- 89,99 ----
  sqlExceptions e = dynExceptions e >>= fromDynamic
  
! checkHandle :: MVar Bool -> IO a -> IO a
! checkHandle ref action =
! 	withMVar ref (\closed -> when closed (throwDyn SqlClosedHandle) >> action)
  
! closeHandle :: MVar Bool -> IO () -> IO ()
! closeHandle ref action =
! 	modifyMVar_ ref (\closed -> unless closed action >> return True)
  
  -----------------------------------------------------------------------------------------
***************
*** 107,111 ****
  -- closed has no effect. All other operations on a closed connection will fail.
  disconnect :: Connection -> IO ()
! disconnect = closeHandle connClosed connDisconnect
  	
  -- | Submits a command to the database.
--- 104,108 ----
  -- closed has no effect. All other operations on a closed connection will fail.
  disconnect :: Connection -> IO ()
! disconnect conn = closeHandle (connClosed conn) (connDisconnect conn)
  	
  -- | Submits a command to the database.
***************
*** 113,119 ****
          -> String      -- ^ the text of SQL command
          -> IO ()
! execute conn query = do
! 	checkHandle (connClosed conn)
! 	connExecute conn query
  
  -- | Executes a query and returns a result set
--- 110,114 ----
          -> String      -- ^ the text of SQL command
          -> IO ()
! execute conn query = checkHandle (connClosed conn) (connExecute conn query)
  
  -- | Executes a query and returns a result set
***************
*** 122,135 ****
        -> IO Statement  -- ^ the associated statement. Must be closed with 
                         -- the 'closeStatement' function
! query conn query = do
! 	checkHandle (connClosed conn)
! 	connQuery conn query
  
  -- | List all tables in the database.
  tables :: Connection   -- ^ Database connection
         -> IO [String]  -- ^ The names of all tables in the database.
! tables conn = do
! 	checkHandle (connClosed conn)
! 	connTables conn
  
  -- | List all columns in a table along with their types and @nullable@ flags
--- 117,127 ----
        -> IO Statement  -- ^ the associated statement. Must be closed with 
                         -- the 'closeStatement' function
! query conn query = checkHandle (connClosed conn) (connQuery conn query)
! 	
  
  -- | List all tables in the database.
  tables :: Connection   -- ^ Database connection
         -> IO [String]  -- ^ The names of all tables in the database.
! tables conn = checkHandle (connClosed conn) (connTables conn)
  
  -- | List all columns in a table along with their types and @nullable@ flags
***************
*** 137,143 ****
  	 -> String        -- ^ Name of a database table
  	 -> IO [FieldDef] -- ^ The list of fields in the table
! describe conn table = do
! 	checkHandle (connClosed conn)
! 	connDescribe conn table
  
  -----------------------------------------------------------------------------------------
--- 129,133 ----
  	 -> String        -- ^ Name of a database table
  	 -> IO [FieldDef] -- ^ The list of fields in the table
! describe conn table = checkHandle (connClosed conn) (connDescribe conn table)
  
  -----------------------------------------------------------------------------------------
***************
*** 153,162 ****
                -> IO a                  -- ^ the returned value is the result returned from action
  inTransaction conn action = do
! 	checkHandle (connClosed conn)	
! 	connBeginTransaction conn
  	r <- catchSql (action conn) (\err -> do
! 			connRollbackTransaction conn
  			throwDyn err)
! 	connCommitTransaction conn
  	return r
  
--- 143,151 ----
                -> IO a                  -- ^ the returned value is the result returned from action
  inTransaction conn action = do
! 	checkHandle (connClosed conn) (connBeginTransaction conn)
  	r <- catchSql (action conn) (\err -> do
! 			checkHandle (connClosed conn) (connRollbackTransaction conn)
  			throwDyn err)
! 	checkHandle (connClosed conn) (connCommitTransaction conn)
  	return r
  
***************
*** 168,174 ****
  -- The values from columns can be retrieved with 'getFieldValue' function.
  fetch :: Statement -> IO Bool
! fetch stmt = do
! 	checkHandle (stmtClosed stmt)
! 	stmtFetch stmt
  
  -- | 'closeStatement' stops processing associated with a specific statement, closes any open cursors
--- 157,161 ----
  -- The values from columns can be retrieved with 'getFieldValue' function.
  fetch :: Statement -> IO Bool
! fetch stmt = checkHandle (stmtClosed stmt) (stmtFetch stmt)
  
  -- | 'closeStatement' stops processing associated with a specific statement, closes any open cursors
***************
*** 177,181 ****
  -- closed has no effect. All other operations on a closed statement will fail.
  closeStatement :: Statement -> IO ()
! closeStatement = closeHandle stmtClosed stmtClose
  
  -- | Returns the type and the @nullable@ flag for field with specified name
--- 164,168 ----
  -- closed has no effect. All other operations on a closed statement will fail.
  closeStatement :: Statement -> IO ()
! closeStatement stmt = closeHandle (stmtClosed stmt) (stmtClose stmt)
  
  -- | Returns the type and the @nullable@ flag for field with specified name
***************
*** 536,541 ****
                               -> String         -- ^ Field name
                               -> IO (Maybe a)   -- ^ Field value or Nothing
! getFieldValueMB stmt name = do
! 	checkHandle (stmtClosed stmt)
  	stmtGetCol stmt colNumber (name,sqlType,nullable) fromNonNullSqlCStringLen
  	where
--- 523,527 ----
                               -> String         -- ^ Field name
                               -> IO (Maybe a)   -- ^ Field value or Nothing
! getFieldValueMB stmt name = checkHandle (stmtClosed stmt) $
  	stmtGetCol stmt colNumber (name,sqlType,nullable) fromNonNullSqlCStringLen
  	where

[htoolkit-cvs] HSQL/src HSQL.hsc,1.5,1.6

From: <kr_...@us...> - 2004-02-09 21:53:11

Update of /cvsroot/htoolkit/HSQL/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23722

Modified Files:
	HSQL.hsc 
Log Message:
Fix the bug with dates (PostgreSQL)


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL.hsc,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** HSQL.hsc	9 Feb 2004 06:33:10 -0000	1.5
--- HSQL.hsc	9 Feb 2004 21:49:43 -0000	1.6
***************
*** 1,32 ****
! -----------------------------------------------------------------------------------------
! {-| Module      :  Database.HSQL.ODBC
!     Copyright   :  (c) Krasimir Angelov 2003
!     License     :  BSD-style
! 
!     Maintainer  :  ka2...@ya...
!     Stability   :  provisional
!     Portability :  portable
! 
!     The module provides an abstract database interface
! -}
! -----------------------------------------------------------------------------------------
! 
  module Database.HSQL
! 	(
! 	-- * Connect\/Disconnect
! 	  Connection
  	, disconnect        -- :: Connection -> IO ()
! 	
! 	-- * Command Execution Functions
! 	-- | Once a connection to a database has been successfully established, 
! 	-- the functions described here are used to perform SQL queries and commands.
  	, execute           -- :: Connection -> String -> IO ()
! 	, Statement
  	, query             -- :: Connection -> String -> IO Statement
  	, closeStatement    -- :: Statement -> IO ()
  	, fetch             -- :: Statement -> IO Bool
! 	
! 	-- * Retrieving Statement values and types
! 	, FieldDef, SqlType(..), SqlBind
  	, getFieldValueMB   -- :: SqlBind a => Statement -> String -> IO (Maybe a)
  	, getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
--- 1,32 ----
! -----------------------------------------------------------------------------------------
! {-| Module      :  Database.HSQL.ODBC
!     Copyright   :  (c) Krasimir Angelov 2003
!     License     :  BSD-style
! 
!     Maintainer  :  ka2...@ya...
!     Stability   :  provisional
!     Portability :  portable
! 
!     The module provides an abstract database interface
! -}
! -----------------------------------------------------------------------------------------
! 
  module Database.HSQL
! 	(
! 	-- * Connect\/Disconnect
! 	  Connection
  	, disconnect        -- :: Connection -> IO ()
! 	
! 	-- * Command Execution Functions
! 	-- | Once a connection to a database has been successfully established, 
! 	-- the functions described here are used to perform SQL queries and commands.
  	, execute           -- :: Connection -> String -> IO ()
! 	, Statement
  	, query             -- :: Connection -> String -> IO Statement
  	, closeStatement    -- :: Statement -> IO ()
  	, fetch             -- :: Statement -> IO Bool
! 	
! 	-- * Retrieving Statement values and types
! 	, FieldDef, SqlType(..), SqlBind
  	, getFieldValueMB   -- :: SqlBind a => Statement -> String -> IO (Maybe a)
  	, getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
***************
*** 34,54 ****
  	, getFieldValueType -- :: Statement -> String -> (SqlType, Bool)
  	, getFieldsTypes    -- :: Statement -> [(String, SqlType, Bool)]
! 	
! 	-- * Transactions
! 	, inTransaction     -- :: Connection -> (Connection -> IO a) -> IO a
! 
! 	
! 	-- * SQL Exceptions handling
! 	, SqlError(..)
! 	, catchSql          -- :: IO a -> (SqlError -> IO a) -> IO a
! 	, handleSql         -- :: (SqlError -> IO a) -> IO a -> IO a
! 	, sqlExceptions     -- :: Exception -> Maybe SqlError
! 	
! 	-- * Utilities
  	, forEachRow        -- :: (Statement -> s -> IO s) -- ^ an action
  	, forEachRow'       -- :: (Statement -> IO ()) -> Statement -> IO ()
  	, collectRows       -- :: (Statement -> IO a) -> Statement -> IO [a]
! 	
! 	-- * Metadata
  	, tables            -- :: Connection -> IO [String]
  	, describe          -- :: Connection -> String -> IO [FieldDef]
--- 34,54 ----
  	, getFieldValueType -- :: Statement -> String -> (SqlType, Bool)
  	, getFieldsTypes    -- :: Statement -> [(String, SqlType, Bool)]
! 	
! 	-- * Transactions
! 	, inTransaction     -- :: Connection -> (Connection -> IO a) -> IO a
! 
! 	
! 	-- * SQL Exceptions handling
! 	, SqlError(..)
! 	, catchSql          -- :: IO a -> (SqlError -> IO a) -> IO a
! 	, handleSql         -- :: (SqlError -> IO a) -> IO a -> IO a
! 	, sqlExceptions     -- :: Exception -> Maybe SqlError
! 	
! 	-- * Utilities
  	, forEachRow        -- :: (Statement -> s -> IO s) -- ^ an action
  	, forEachRow'       -- :: (Statement -> IO ()) -> Statement -> IO ()
  	, collectRows       -- :: (Statement -> IO a) -> Statement -> IO [a]
! 	
! 	-- * Metadata
  	, tables            -- :: Connection -> IO [String]
  	, describe          -- :: Connection -> String -> IO [FieldDef]
***************
*** 62,67 ****
  import Data.Int
  import Data.Char
! import Data.Dynamic
! import Data.IORef
  import System.Time
  import System.IO.Unsafe(unsafePerformIO)
--- 62,67 ----
  import Data.Int
  import Data.Char
! import Data.Dynamic
! import Data.IORef
  import System.Time
  import System.IO.Unsafe(unsafePerformIO)
***************
*** 72,76 ****
  import Text.Read.Lex
  import Numeric
! import Database.HSQL.Types
  
  #include <time.h>
--- 72,76 ----
  import Text.Read.Lex
  import Numeric
! import Database.HSQL.Types
  
  #include <time.h>
***************
*** 88,102 ****
  sqlExceptions :: Exception -> Maybe SqlError
  sqlExceptions e = dynExceptions e >>= fromDynamic
- 
- checkHandle :: IORef Bool -> IO ()
- checkHandle ref = do
- 	closed <- readIORef ref
- 	when closed (throwDyn SqlClosedHandle)
  
! closeHandle :: (a -> IORef Bool) -> (a -> IO ()) -> a -> IO ()
! closeHandle getRef action handle = do
! 	closed <- readIORef (getRef handle)
! 	unless closed (action handle)
! 	writeIORef (getRef handle) True
  
  -----------------------------------------------------------------------------------------
--- 88,102 ----
  sqlExceptions :: Exception -> Maybe SqlError
  sqlExceptions e = dynExceptions e >>= fromDynamic
  
! checkHandle :: IORef Bool -> IO ()
! checkHandle ref = do
! 	closed <- readIORef ref
! 	when closed (throwDyn SqlClosedHandle)
! 
! closeHandle :: (a -> IORef Bool) -> (a -> IO ()) -> a -> IO ()
! closeHandle getRef action handle = do
! 	closed <- readIORef (getRef handle)
! 	unless closed (action handle)
! 	writeIORef (getRef handle) True
  
  -----------------------------------------------------------------------------------------
***************
*** 109,113 ****
  disconnect = closeHandle connClosed connDisconnect
  	
! -- | Submits a command to the database.
  execute :: Connection  -- ^ the database connection
          -> String      -- ^ the text of SQL command
--- 109,113 ----
  disconnect = closeHandle connClosed connDisconnect
  	
! -- | Submits a command to the database.
  execute :: Connection  -- ^ the database connection
          -> String      -- ^ the text of SQL command
***************
*** 123,127 ****
                         -- the 'closeStatement' function
  query conn query = do
! 	checkHandle (connClosed conn)
  	connQuery conn query
  
--- 123,127 ----
                         -- the 'closeStatement' function
  query conn query = do
! 	checkHandle (connClosed conn)
  	connQuery conn query
  
***************
*** 130,134 ****
         -> IO [String]  -- ^ The names of all tables in the database.
  tables conn = do
! 	checkHandle (connClosed conn)
  	connTables conn
  
--- 130,134 ----
         -> IO [String]  -- ^ The names of all tables in the database.
  tables conn = do
! 	checkHandle (connClosed conn)
  	connTables conn
  
***************
*** 138,142 ****
  	 -> IO [FieldDef] -- ^ The list of fields in the table
  describe conn table = do
! 	checkHandle (connClosed conn)
  	connDescribe conn table
  
--- 138,142 ----
  	 -> IO [FieldDef] -- ^ The list of fields in the table
  describe conn table = do
! 	checkHandle (connClosed conn)
  	connDescribe conn table
  
***************
*** 152,157 ****
                -> (Connection -> IO a)  -- ^ an action
                -> IO a                  -- ^ the returned value is the result returned from action
! inTransaction conn action = do
! 	checkHandle (connClosed conn)	
  	connBeginTransaction conn
  	r <- catchSql (action conn) (\err -> do
--- 152,157 ----
                -> (Connection -> IO a)  -- ^ an action
                -> IO a                  -- ^ the returned value is the result returned from action
! inTransaction conn action = do
! 	checkHandle (connClosed conn)	
  	connBeginTransaction conn
  	r <- catchSql (action conn) (\err -> do
***************
*** 169,173 ****
  fetch :: Statement -> IO Bool
  fetch stmt = do
! 	checkHandle (stmtClosed stmt)
  	stmtFetch stmt
  
--- 169,173 ----
  fetch :: Statement -> IO Bool
  fetch stmt = do
! 	checkHandle (stmtClosed stmt)
  	stmtFetch stmt
  
***************
*** 200,208 ****
  
  foreign import ccall "stdlib.h atoi" c_atoi :: CString -> IO Int
! #ifdef WIN32
! foreign import ccall "stdlib.h _atoi64" c_atoi64 :: CString -> IO Int64
! #else
! foreign import ccall "stdlib.h strtoll" c_strtoll :: CString -> Ptr CString -> Int -> IO Int64
! #endif
  
  instance SqlBind Int where
--- 200,208 ----
  
  foreign import ccall "stdlib.h atoi" c_atoi :: CString -> IO Int
! #ifdef WIN32
! foreign import ccall "stdlib.h _atoi64" c_atoi64 :: CString -> IO Int64
! #else
! foreign import ccall "stdlib.h strtoll" c_strtoll :: CString -> Ptr CString -> Int -> IO Int64
! #endif
  
  instance SqlBind Int where
***************
*** 229,237 ****
  	       || sqlType==SqlTinyInt || sqlType==SqlSmallInt || sqlType==SqlBigInt
  	      then do
! #ifdef WIN32
! 	        val <- c_atoi64 cstr
! #else
! 	        val <- c_strtoll cstr nullPtr 10
! #endif
  	        return (Just val)
  	      else
--- 229,237 ----
  	       || sqlType==SqlTinyInt || sqlType==SqlSmallInt || sqlType==SqlBigInt
  	      then do
! #ifdef WIN32
! 	        val <- c_atoi64 cstr
! #else
! 	        val <- c_strtoll cstr nullPtr 10
! #endif
  	        return (Just val)
  	      else
***************
*** 320,323 ****
--- 320,324 ----
  				char ':'
  				seconds <- readDecP
+ 				(char '.' >> readDecP) `mplus` (return 0)
  				tz <- parseTZ
  				return (mkClockTime 1970 0 1 hour minutes seconds (tz*3600))
***************
*** 356,363 ****
  				skipSpaces
  				hour  <- readDecP
! 				char '-'
  				minutes <- readDecP
! 				char '-'
  				seconds <- readDecP
  				tz    <- parseTZ
  				return (mkClockTime year month day hour minutes seconds (tz*3600))
--- 357,365 ----
  				skipSpaces
  				hour  <- readDecP
! 				char ':'
  				minutes <- readDecP
! 				char ':'
  				seconds <- readDecP
+ 				char '.' >> readDecP -- ) `mplus` (return 0)
  				tz    <- parseTZ
  				return (mkClockTime year month day hour minutes seconds (tz*3600))
***************
*** 535,539 ****
                               -> IO (Maybe a)   -- ^ Field value or Nothing
  getFieldValueMB stmt name = do
! 	checkHandle (stmtClosed stmt)
  	stmtGetCol stmt colNumber (name,sqlType,nullable) fromNonNullSqlCStringLen
  	where
--- 537,541 ----
                               -> IO (Maybe a)   -- ^ Field value or Nothing
  getFieldValueMB stmt name = do
! 	checkHandle (stmtClosed stmt)
  	stmtGetCol stmt colNumber (name,sqlType,nullable) fromNonNullSqlCStringLen
  	where

[htoolkit-cvs] HSQL/src/HSQL PostgreSQL.hsc,1.7,1.8

From: <kr_...@us...> - 2004-02-09 21:53:11

Update of /cvsroot/htoolkit/HSQL/src/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23722/HSQL

Modified Files:
	PostgreSQL.hsc 
Log Message:
Fix the bug with dates (PostgreSQL)


Index: PostgreSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL/PostgreSQL.hsc,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** PostgreSQL.hsc	4 Feb 2004 10:15:50 -0000	1.7
--- PostgreSQL.hsc	9 Feb 2004 21:49:43 -0000	1.8
***************
*** 163,167 ****
  		mkSqlType (#const INTERVALOID)  size = SqlTimeInterval
  		mkSqlType (#const TINTERVALOID) size = SqlAbsTimeInterval
! 		mkSqlType (#const TIMESTAMPOID)	size = SqlDateTimeTZ
  		mkSqlType (#const CASHOID)      size = SqlMoney
  		mkSqlType (#const INETOID)      size = SqlINetAddr
--- 163,168 ----
  		mkSqlType (#const INTERVALOID)  size = SqlTimeInterval
  		mkSqlType (#const TINTERVALOID) size = SqlAbsTimeInterval
! 		mkSqlType (#const TIMESTAMPOID)	size = SqlDateTime
! 		mkSqlType (#const TIMESTAMPTZOID)	size = SqlDateTimeTZ
  		mkSqlType (#const CASHOID)      size = SqlMoney
  		mkSqlType (#const INETOID)      size = SqlINetAddr

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.20,1.21

From: <br...@us...> - 2004-01-21 21:53:41

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv25484

Modified Files:
	HSQL.hsc 
Log Message:
Previously, calling closeStatement twice on the same statement would cause hSTMT and fetchBuffer to be freed twice (whic is not a Good Thing). I added an IORef Bool field to Statement to keep track of whether the statement has already been closed.


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** HSQL.hsc	21 Jan 2004 21:17:19 -0000	1.20
--- HSQL.hsc	21 Jan 2004 21:53:38 -0000	1.21
***************
*** 107,110 ****
--- 107,111 ----
  		, fetchBuffer	  :: !(Ptr ())
  		, fetchBufferSize :: !SQLINTEGER
+ 		, closed          :: !(IORef Bool) -- To avoid freeing hSTMT and fetchBuffer twice
  		}
  
***************
*** 293,297 ****
  	free pFIELD
  	buffer <- mallocBytes (fromIntegral bufSize)
! 	let statement = Statement {hSTMT=hSTMT, connection=conn, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufSize}
  	return statement
  	where
--- 294,300 ----
  	free pFIELD
  	buffer <- mallocBytes (fromIntegral bufSize)
! 	closed <- newIORef False
! 	let statement = Statement {hSTMT=hSTMT, connection=conn, fields=fields, 
! 				   fetchBuffer=buffer, fetchBufferSize=bufSize, closed=closed}
  	return statement
  	where
***************
*** 362,367 ****
  closeStatement :: Statement -> IO ()
  closeStatement stmt = do
! 	free (fetchBuffer stmt)
! 	sqlFreeStmt (hSTMT stmt) 0 >>= handleSqlResult (#const SQL_HANDLE_STMT) (hSTMT stmt)
  
  -----------------------------------------------------------------------------------------
--- 365,376 ----
  closeStatement :: Statement -> IO ()
  closeStatement stmt = do
!         alreadyClosed <- readIORef (closed stmt)
! 	unless alreadyClosed realClose
! 	    where 
! 	    realClose = do
!               free (fetchBuffer stmt)
!               sqlFreeStmt (hSTMT stmt) 0 >>= handleSqlResult (#const SQL_HANDLE_STMT) (hSTMT stmt)
!               writeIORef (closed stmt) True
! 
  
  -----------------------------------------------------------------------------------------

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.19,1.20

From: <br...@us...> - 2004-01-21 21:17:22

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv16689

Modified Files:
	HSQL.hsc 
Log Message:
Fixed conversion of SqlReal values. Before they where returned as floats by the driver, and the pointer was cast to a double, which produced bad values.


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** HSQL.hsc	21 Jan 2004 20:45:34 -0000	1.19
--- HSQL.hsc	21 Jan 2004 21:17:19 -0000	1.20
***************
*** 593,597 ****
  			SqlSmallInt        -> (#const SQL_C_SSHORT)
  			SqlInteger         -> (#const SQL_C_SLONG)
! 			SqlReal            -> (#const SQL_C_FLOAT)
  			SqlFloat           -> (#const SQL_C_DOUBLE)
  			SqlDouble          -> (#const SQL_C_DOUBLE)
--- 593,601 ----
  			SqlSmallInt        -> (#const SQL_C_SSHORT)
  			SqlInteger         -> (#const SQL_C_SLONG)
!                         -- SqlReal actually corresponds to a float, not a double,
! 			-- but we let the driver take care of that conversion
! 			-- so that we can assume that we always have a C double
! 			-- to convert to a Haskell Double.
! 			SqlReal            -> (#const SQL_C_DOUBLE)
  			SqlFloat           -> (#const SQL_C_DOUBLE)
  			SqlDouble          -> (#const SQL_C_DOUBLE)

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.18,1.19

From: <br...@us...> - 2004-01-21 20:45:37

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv9207

Modified Files:
	HSQL.hsc 
Log Message:
Made the minimum buffer size 256 bytes. Since because some databases do not return the right type for columns in the results of catalog functions, we make sure that the buffer is large enough to avoid having to use getLongData for most such result sets.


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** HSQL.hsc	14 Jan 2004 16:17:22 -0000	1.18
--- HSQL.hsc	21 Jan 2004 20:45:34 -0000	1.19
***************
*** 285,289 ****
  	sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult
  	count <- (#peek FIELD, fieldsCount) pFIELD
! 	(fields, bufSize) <- getFieldDefs hSTMT pFIELD 1 count
  	free pFIELD
  	buffer <- mallocBytes (fromIntegral bufSize)
--- 285,294 ----
  	sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult
  	count <- (#peek FIELD, fieldsCount) pFIELD
! 	(fields, minSize) <- getFieldDefs hSTMT pFIELD 1 count
! 	-- because some databases do not return the right type for columns
! 	-- in the results of catalog functions, we make sure that the buffer
! 	-- is large enough to avoid having to use getLongData for most 
!         -- such result sets.
! 	let bufSize = max minSize 256 
  	free pFIELD
  	buffer <- mallocBytes (fromIntegral bufSize)

[htoolkit-cvs] HSQL configure.ac,1.8,1.9

From: <br...@us...> - 2004-01-15 23:11:28

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1:/tmp/cvs-serv14468

Modified Files:
	configure.ac 
Log Message:
Now uses mysql_config --cflags and keeps only -I options. Older MySQL versions do not support mysql_config --include which was used before. Check for mysql.h instead of mysql/mysql.h since that is what the code uses.


Index: configure.ac
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/configure.ac,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** configure.ac	14 Jan 2004 15:54:43 -0000	1.8
--- configure.ac	15 Jan 2004 23:11:25 -0000	1.9
***************
*** 289,295 ****
  
  LDFLAGS="$LDFLAGS `$MYSQL_CONFIG --libs`"
- CPPFLAGS="$CPPFLAGS `$MYSQL_CONFIG --include`"
  
! AC_CHECK_HEADER(mysql/mysql.h,, AC_MSG_ERROR([mysql.h header not found]))
  
  fi
--- 289,302 ----
  
  LDFLAGS="$LDFLAGS `$MYSQL_CONFIG --libs`"
  
! for mysql_opt in `$MYSQL_CONFIG --cflags`
! do
!    case $mysql_opt in
! 	 -I*)
! 		CPPFLAGS="$CPPFLAGS ${mysql_opt}";;
!    esac
! done
! 
! AC_CHECK_HEADER(mysql.h,, AC_MSG_ERROR([mysql.h header not found]))
  
  fi

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.17,1.18

From: <br...@us...> - 2004-01-14 16:17:25

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv1588

Modified Files:
	HSQL.hsc 
Log Message:
Some database drivers do not seem to set the type of the columns in the results returned by SQLColumns() and SQLTables() correctly. Changed tables and describe to work around this by hard-coding the result column types.


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** HSQL.hsc	14 Jan 2004 16:07:31 -0000	1.17
--- HSQL.hsc	14 Jan 2004 16:17:22 -0000	1.18
***************
*** 40,43 ****
--- 40,44 ----
  import Data.IORef
  import Data.Dynamic
+ import Data.Maybe
  import Foreign
  import Foreign.C
***************
*** 371,375 ****
        -- Column name     #   Type
        -- TABLE_NAME      3   VARCHAR
!       collectRows (\s -> getColValue s 3) stmt
        where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
  
--- 372,376 ----
        -- Column name     #   Type
        -- TABLE_NAME      3   VARCHAR
!       collectRows (\s -> getColValue s 3 (SqlVarChar 0)) stmt
        where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
  
***************
*** 394,424 ****
        getColumnInfo stmt =
  	  do
! 	  column_name <- getColValue stmt 4
! 	  (data_type::Int) <- getColValue stmt 5 
! 	  (column_size::Int) <- getColValue' stmt 7 0
! 	  (decimal_digits::Int) <- getColValue' stmt 9 0
! 	  (nullable::Int) <- getColValue stmt 11
  	  let (sqlType,_) = mkSqlType (fromIntegral data_type) 
  			              (fromIntegral column_size) 
  				      (fromIntegral decimal_digits)
! 	  return (column_name, sqlType, nullable /= (#const SQL_NO_NULLS))
! 
! -- | Get the name of a field given its column number. For internal use.
! getColName :: Statement -> Int -> String
! getColName stmt colNumber 
!     | colNumber >= 1 && colNumber <= length fs = 
! 	let (name,_,_) = fs!!(colNumber-1) in name
!     | otherwise = error $ "Bad column: " ++ show colNumber ++ " (1 - " 
! 			      ++ show (length fs) ++ ")"
!     where fs = fields stmt
! 
! -- | Get the value of a column by number. For internal use.
! getColValue :: SqlBind a => Statement -> Int -> IO a
! getColValue stmt colNumber = getFieldValue stmt (getColName stmt colNumber)
! 
! -- | Get the value of a column by number, with a default value
! --   to return instead of NULL. For internal use.
! getColValue' :: SqlBind a => Statement -> Int -> a -> IO a
! getColValue' stmt colNumber def = getFieldValue' stmt (getColName stmt colNumber) def
  
  -----------------------------------------------------------------------------------------
--- 395,407 ----
        getColumnInfo stmt =
  	  do
! 	  column_name <- getColValue stmt 4 (SqlVarChar 0)
! 	  (data_type::Int) <- getColValue stmt 5 SqlSmallInt
! 	  (column_size::Int) <- getColValue' stmt 7 SqlInteger 0
! 	  (decimal_digits::Int) <- getColValue' stmt 9 SqlSmallInt 0
! 	  (nullable::Int) <- getColValue stmt 11 SqlSmallInt
  	  let (sqlType,_) = mkSqlType (fromIntegral data_type) 
  			              (fromIntegral column_size) 
  				      (fromIntegral decimal_digits)
! 	  return (column_name, sqlType, toBool nullable)
  
  -----------------------------------------------------------------------------------------
***************
*** 541,546 ****
                               -> String         -- ^ Field name
                               -> IO (Maybe a)   -- ^ Field value or Nothing
! getFieldValueMB (Statement {hSTMT=hSTMT, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufferSize}) name = 
!     do
  	(res,len_or_ind) <- getData buffer bufferSize 
  	if len_or_ind == (#const SQL_NULL_DATA) 
--- 524,550 ----
                               -> String         -- ^ Field name
                               -> IO (Maybe a)   -- ^ Field value or Nothing
! getFieldValueMB stmt name = getColValueMB stmt colNumber sqlType
!     where (sqlType,nullable,colNumber) = findFieldInfo name (fields stmt) 1
! 
! -- | Get the value of a column by number. For internal use.
! getColValue :: SqlBind a => Statement -> SQLUSMALLINT -> SqlType -> IO a
! getColValue stmt colNumber t = do
! 	mb_v <- getColValueMB stmt colNumber t
! 	maybe (throwDyn (SqlFetchNull (show colNumber))) return mb_v
! 
! -- | Get the value of a column by number, with a default value
! --   to return instead of NULL. For internal use.
! getColValue' :: SqlBind a => Statement -> SQLUSMALLINT -> SqlType -> a -> IO a
! getColValue' stmt colNumber t def = fmap (fromMaybe def) (getColValueMB stmt colNumber t)
! 
! -- | Retrieves the value of field with the specified column number and type.
! -- The returned value is Nothing if the field value is @null@. For internal use.
! getColValueMB :: SqlBind a => 
! 		 Statement 
! 	      -> SQLUSMALLINT   -- ^ Column number (1-based)
! 	      -> SqlType        -- ^ Column type
!               -> IO (Maybe a)   -- ^ Field value or Nothing
! getColValueMB (Statement {hSTMT=hSTMT, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufferSize}) 
! 	      colNumber sqlType  = do
  	(res,len_or_ind) <- getData buffer bufferSize 
  	if len_or_ind == (#const SQL_NULL_DATA) 
***************
*** 552,559 ****
  			case mb_value of
  				Just value -> return (Just value)
! 				Nothing    -> throwDyn (SqlBadTypeCast name sqlType)
  	where
- 		(sqlType,nullable,colNumber) = findFieldInfo name fields 1
- 
  		-- | Get data from the current column to the given buffer
  		getData :: Ptr () -> SQLINTEGER -> IO (SQLRETURN, SQLINTEGER)
--- 556,561 ----
  			case mb_value of
  				Just value -> return (Just value)
! 				Nothing    -> throwDyn (SqlBadTypeCast (show colNumber) sqlType)
  	where
  		-- | Get data from the current column to the given buffer
  		getData :: Ptr () -> SQLINTEGER -> IO (SQLRETURN, SQLINTEGER)
***************
*** 581,586 ****
  			where newBufSize = len+1 -- to allow for terminating null character
  
- 
- 
  		targetType = case sqlType of
  			SqlBit             -> (#const SQL_C_BIT)
--- 583,586 ----

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.16,1.17

From: <br...@us...> - 2004-01-14 16:07:34

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv31151

Modified Files:
	HSQL.hsc 
Log Message:
Fixed tables and describe to use column numbers instead of column names.

Fixed bug in long data handling where the data retrieved by the initial SQLGetData() call would be discarded. 

The data buffer in the Statement object now contains only data, len_or_ind is returned in a separate temporary buffer instead. 

Added support for SQL_FLOAT (treating it as SQL_DOUBLE for now, that seems to be the most common case).


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** HSQL.hsc	5 Jan 2004 20:23:25 -0000	1.16
--- HSQL.hsc	14 Jan 2004 16:07:31 -0000	1.17
***************
*** 122,125 ****
--- 122,126 ----
  	| SqlInteger
  	| SqlReal
+ 	| SqlFloat
  	| SqlDouble
  	| SqlBit
***************
*** 285,289 ****
  	(fields, bufSize) <- getFieldDefs hSTMT pFIELD 1 count
  	free pFIELD
! 	buffer <- mallocBytes (fromIntegral (bufSize+(#const sizeof(SQLINTEGER))))
  	let statement = Statement {hSTMT=hSTMT, connection=conn, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufSize}
  	return statement
--- 286,290 ----
  	(fields, bufSize) <- getFieldDefs hSTMT pFIELD 1 count
  	free pFIELD
! 	buffer <- mallocBytes (fromIntegral bufSize)
  	let statement = Statement {hSTMT=hSTMT, connection=conn, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufSize}
  	return statement
***************
*** 314,317 ****
--- 315,323 ----
  mkSqlType (#const SQL_INTEGER)      _       _    = (SqlInteger, (#const sizeof(SQLINTEGER)))
  mkSqlType (#const SQL_REAL)         _       _    = (SqlReal, (#const sizeof(SQLDOUBLE)))
+ -- From: http://msdn.microsoft.com/library/en-us/odbc/htm/odappdpr_2.asp
+ -- "Depending on the implementation, the precision of SQL_FLOAT can be either 24 or 53: 
+ -- if it is 24, the SQL_FLOAT data type is the same as SQL_REAL; 
+ -- if it is 53, the SQL_FLOAT data type is the same as SQL_DOUBLE."
+ mkSqlType (#const SQL_FLOAT)        _        _    = (SqlFloat, (#const sizeof(SQLDOUBLE)))
  mkSqlType (#const SQL_DOUBLE)		_    	_    = (SqlDouble, (#const sizeof(SQLDOUBLE)))
  mkSqlType (#const SQL_BIT)          _    	_    = (SqlBit, (#const sizeof(SQLINTEGER)))
***************
*** 327,331 ****
  mkSqlType (#const SQL_WVARCHAR)     size    _    = (SqlWVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
  mkSqlType (#const SQL_WLONGVARCHAR)	size    _    = (SqlWLongVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
! 
  
  -- | Executes the statement and returns a 'Statement' value which represents the result set
--- 333,339 ----
  mkSqlType (#const SQL_WVARCHAR)     size    _    = (SqlWVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
  mkSqlType (#const SQL_WLONGVARCHAR)	size    _    = (SqlWLongVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
! mkSqlType t                         size    prec     = error $ "Unsupported SQL type: " ++ show t 
! 						       ++ " (size: " ++ show size 
! 						       ++ ", precision: " ++ show prec ++ ")"
  
  -- | Executes the statement and returns a 'Statement' value which represents the result set
***************
*** 360,367 ****
  tables conn = do
        stmt <- withStatement conn sqlTables'
!       -- SQLTables returns:
        -- Column name     #   Type
        -- TABLE_NAME      3   VARCHAR
!       collectRows (\s -> getFieldValue' s "TABLE_NAME" "") stmt
        where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
  
--- 368,375 ----
  tables conn = do
        stmt <- withStatement conn sqlTables'
!       -- SQLTables returns (column names may vary):
        -- Column name     #   Type
        -- TABLE_NAME      3   VARCHAR
!       collectRows (\s -> getColValue s 3) stmt
        where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
  
***************
*** 377,381 ****
  	  withCStringLen table (\(pTable,len) ->
  	      sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0)
!       -- SQLColumns returns:
        -- Column name     #   Type
        -- COLUMN_NAME     4   Varchar not NULL
--- 385,389 ----
  	  withCStringLen table (\(pTable,len) ->
  	      sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0)
!       -- SQLColumns returns (column names may vary):
        -- Column name     #   Type
        -- COLUMN_NAME     4   Varchar not NULL
***************
*** 386,397 ****
        getColumnInfo stmt =
  	  do
! 	  name <- getFieldValue stmt "COLUMN_NAME"
! 	  (t::Int) <- getFieldValue stmt "DATA_TYPE"
! 	  (size::Int) <- getFieldValue' stmt "COLUMN_SIZE" 0
! 	  (prec::Int) <- getFieldValue' stmt "DECIMAL_DIGITS" 0
! 	  (n::Int) <- getFieldValue stmt "NULLABLE"
! 	  let (sqlType,_) = mkSqlType (fromIntegral t) (fromIntegral size) (fromIntegral prec)
! 	      nullable = n /= (#const SQL_NO_NULLS)
! 	  return (name, sqlType, nullable)
  
  -----------------------------------------------------------------------------------------
--- 394,424 ----
        getColumnInfo stmt =
  	  do
! 	  column_name <- getColValue stmt 4
! 	  (data_type::Int) <- getColValue stmt 5 
! 	  (column_size::Int) <- getColValue' stmt 7 0
! 	  (decimal_digits::Int) <- getColValue' stmt 9 0
! 	  (nullable::Int) <- getColValue stmt 11
! 	  let (sqlType,_) = mkSqlType (fromIntegral data_type) 
! 			              (fromIntegral column_size) 
! 				      (fromIntegral decimal_digits)
! 	  return (column_name, sqlType, nullable /= (#const SQL_NO_NULLS))
! 
! -- | Get the name of a field given its column number. For internal use.
! getColName :: Statement -> Int -> String
! getColName stmt colNumber 
!     | colNumber >= 1 && colNumber <= length fs = 
! 	let (name,_,_) = fs!!(colNumber-1) in name
!     | otherwise = error $ "Bad column: " ++ show colNumber ++ " (1 - " 
! 			      ++ show (length fs) ++ ")"
!     where fs = fields stmt
! 
! -- | Get the value of a column by number. For internal use.
! getColValue :: SqlBind a => Statement -> Int -> IO a
! getColValue stmt colNumber = getFieldValue stmt (getColName stmt colNumber)
! 
! -- | Get the value of a column by number, with a default value
! --   to return instead of NULL. For internal use.
! getColValue' :: SqlBind a => Statement -> Int -> a -> IO a
! getColValue' stmt colNumber def = getFieldValue' stmt (getColName stmt colNumber) def
  
  -----------------------------------------------------------------------------------------
***************
*** 464,467 ****
--- 491,495 ----
  	fromSqlValue (SqlNumeric _ _) ptr size = fmap Just $ peek (castPtr ptr)
  	fromSqlValue SqlDouble ptr size = fmap Just $ peek (castPtr ptr)
+ 	fromSqlValue SqlFloat ptr size = fmap Just $ peek (castPtr ptr)
  	fromSqlValue SqlReal ptr size = fmap Just $ peek (castPtr ptr)
  	fromSqlValue _ _ _ = return Nothing
***************
*** 513,521 ****
                               -> String         -- ^ Field name
                               -> IO (Maybe a)   -- ^ Field value or Nothing
! getFieldValueMB (Statement {hSTMT=hSTMT, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufferSize}) name = do
! 	let dataBuffer = buffer `plusPtr` (#const sizeof(SQLINTEGER))
! 	res <- sqlGetData hSTMT colNumber targetType dataBuffer bufferSize (castPtr buffer)
! 	handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 	(len_or_ind :: SQLINTEGER) <- peek (castPtr buffer)
  	if len_or_ind == (#const SQL_NULL_DATA) 
  		then return Nothing
--- 541,547 ----
                               -> String         -- ^ Field name
                               -> IO (Maybe a)   -- ^ Field value or Nothing
! getFieldValueMB (Statement {hSTMT=hSTMT, fields=fields, fetchBuffer=buffer, fetchBufferSize=bufferSize}) name = 
!     do
! 	(res,len_or_ind) <- getData buffer bufferSize 
  	if len_or_ind == (#const SQL_NULL_DATA) 
  		then return Nothing
***************
*** 523,527 ****
  			mb_value <- (if res == (#const SQL_SUCCESS_WITH_INFO)
  					then getLongData len_or_ind
! 					else fromSqlValue sqlType dataBuffer (fromIntegral len_or_ind))
  			case mb_value of
  				Just value -> return (Just value)
--- 549,553 ----
  			mb_value <- (if res == (#const SQL_SUCCESS_WITH_INFO)
  					then getLongData len_or_ind
! 					else fromSqlValue sqlType buffer (fromIntegral len_or_ind))
  			case mb_value of
  				Just value -> return (Just value)
***************
*** 529,544 ****
  	where
  		(sqlType,nullable,colNumber) = findFieldInfo name fields 1
! 		
! 		getLongData len = do
! 			buffer <- mallocBytes (fromIntegral (len+(#const sizeof(SQLINTEGER))+1))
! 			let dataBuffer = buffer `plusPtr` (#const sizeof(SQLINTEGER))
! 			res <- sqlGetData hSTMT colNumber targetType dataBuffer (len+1) (castPtr buffer)
! 			unless (sqlSuccess res) (free buffer)
! 			handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 			(len_or_ind :: SQLINTEGER) <- peek (castPtr buffer)
! 			r <- fromSqlValue sqlType dataBuffer (fromIntegral len_or_ind)
! 			free buffer
! 			return r
! 			
  		targetType = case sqlType of
  			SqlBit             -> (#const SQL_C_BIT)
--- 555,586 ----
  	where
  		(sqlType,nullable,colNumber) = findFieldInfo name fields 1
! 
! 		-- | Get data from the current column to the given buffer
! 		getData :: Ptr () -> SQLINTEGER -> IO (SQLRETURN, SQLINTEGER)
! 		getData buffer size = alloca $ \lenP -> 
! 		      do
! 		      res <- sqlGetData hSTMT colNumber targetType buffer size lenP
! 		      handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 		      len_or_ind <- peek lenP
! 		      return (res, len_or_ind)
! 
! 		-- gets called only when there is more data than would
! 		-- fit in the normal buffer. This call to
! 		-- SQLGetData() will fetch the rest of the data.
! 		-- We create a new buffer big enough to hold the
! 		-- old and the new data, copy the old data into
! 		-- it and put the new data in buffer after the old.
! 		getLongData len = allocaBytes (fromIntegral newBufSize) $ \newBuf -> do
! 			copyBytes newBuf buffer (fromIntegral bufferSize)
! 		        -- The last byte of the old data with always be null,
! 			-- so it is overwritten with the first byte of  the new data.
! 			let newDataStart = newBuf `plusPtr` (fromIntegral bufferSize - 1)
! 			    newDataLen = newBufSize - (bufferSize - 1)
! 			(res,_) <- getData newDataStart newDataLen
! 			fromSqlValue sqlType newBuf (fromIntegral len)
! 			where newBufSize = len+1 -- to allow for terminating null character
! 
! 
! 
  		targetType = case sqlType of
  			SqlBit             -> (#const SQL_C_BIT)
***************
*** 547,550 ****
--- 589,593 ----
  			SqlInteger         -> (#const SQL_C_SLONG)
  			SqlReal            -> (#const SQL_C_FLOAT)
+ 			SqlFloat           -> (#const SQL_C_DOUBLE)
  			SqlDouble          -> (#const SQL_C_DOUBLE)
  			SqlDate            -> (#const SQL_C_TIMESTAMP)

[htoolkit-cvs] HSQL/MySQL HSQL.hsc,1.12,1.13

From: <br...@us...> - 2004-01-14 15:56:43

Update of /cvsroot/htoolkit/HSQL/MySQL
In directory sc8-pr-cvs1:/tmp/cvs-serv28414/MySQL

Modified Files:
	HSQL.hsc 
Log Message:
Added missing argument to export list comment for connect

Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MySQL/HSQL.hsc,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** HSQL.hsc	5 Jan 2004 20:57:45 -0000	1.12
--- HSQL.hsc	14 Jan 2004 15:56:40 -0000	1.13
***************
*** 6,10 ****
  		, handleSql         -- :: (SqlError -> IO a) -> IO a -> IO a
  		, sqlExceptions     -- :: Exception -> Maybe SqlError
! 		, connect           -- :: String -> String -> String -> IO Connection
  		, disconnect        -- :: Connection -> IO ()
  		, execute           -- :: Connection -> String -> IO ()
--- 6,10 ----
  		, handleSql         -- :: (SqlError -> IO a) -> IO a -> IO a
  		, sqlExceptions     -- :: Exception -> Maybe SqlError
! 		, connect           -- :: String -> String -> String -> String -> IO Connection
  		, disconnect        -- :: Connection -> IO ()
  		, execute           -- :: Connection -> String -> IO ()

[htoolkit-cvs] HSQL configure.ac,1.7,1.8

From: <br...@us...> - 2004-01-14 15:54:48

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1:/tmp/cvs-serv27946

Modified Files:
	configure.ac 
Log Message:
Use mysql_config --include instead of mysql_config --cflags, since --cflags can contain flags that ghc does not accept

Index: configure.ac
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/configure.ac,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** configure.ac	4 Jan 2004 16:25:00 -0000	1.7
--- configure.ac	14 Jan 2004 15:54:43 -0000	1.8
***************
*** 289,293 ****
  
  LDFLAGS="$LDFLAGS `$MYSQL_CONFIG --libs`"
! CPPFLAGS="$CPPFLAGS `$MYSQL_CONFIG --cflags`"
  
  AC_CHECK_HEADER(mysql/mysql.h,, AC_MSG_ERROR([mysql.h header not found]))
--- 289,293 ----
  
  LDFLAGS="$LDFLAGS `$MYSQL_CONFIG --libs`"
! CPPFLAGS="$CPPFLAGS `$MYSQL_CONFIG --include`"
  
  AC_CHECK_HEADER(mysql/mysql.h,, AC_MSG_ERROR([mysql.h header not found]))

[htoolkit-cvs] HSQL/MySQL HSQL.hsc,1.11,1.12

From: <kr_...@us...> - 2004-01-05 20:57:49

Update of /cvsroot/htoolkit/HSQL/MySQL
In directory sc8-pr-cvs1:/tmp/cvs-serv10102/MySQL

Modified Files:
	HSQL.hsc 
Log Message:
Implementation for "tables" and "decribe" functions


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MySQL/HSQL.hsc,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** HSQL.hsc	4 Jan 2004 13:14:58 -0000	1.11
--- HSQL.hsc	5 Jan 2004 20:57:45 -0000	1.12
***************
*** 21,24 ****
--- 21,26 ----
  		, forEachRow'       -- :: (Statement -> IO ()) -> Statement -> IO ()
  		, collectRows       -- :: (Statement -> IO s) -> Statement -> IO [s]
+ 		, tables            -- :: Connection -> IO [String]
+ 		, describe          -- :: Connection -> String -> IO [(String, SqlType, Bool)]
  		) where
  
***************
*** 57,60 ****
--- 59,64 ----
  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 "mysql.h mysql_list_tables" mysql_list_tables :: MYSQL -> CString -> IO MYSQL_RES
+ foreign import ccall "mysql.h mysql_list_fields" mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES
  
  foreign import ccall "stdlib.h atoi" c_atoi :: CString -> IO Int
***************
*** 175,185 ****
  	when (res /= 0) (handleSqlError pMYSQL)
  
! -- | Executes the statement and returns a 'Statement' value which represents the result set
! query :: Connection -> String -> IO Statement
! query conn@(Connection pMYSQL) query = do
! 	res <- withCString query (mysql_query pMYSQL)
! 	when (res /= 0) (handleSqlError pMYSQL)
  	currRow <- newIORef (nullPtr, nullPtr)
- 	pRes <- mysql_use_result pMYSQL	
  	if (pRes == nullPtr)
  		then do
--- 179,186 ----
  	when (res /= 0) (handleSqlError pMYSQL)
  
! withStatement :: Connection -> (MYSQL -> IO MYSQL_RES) -> IO Statement
! withStatement conn@(Connection pMYSQL) f = do
! 	pRes <- f pMYSQL
  	currRow <- newIORef (nullPtr, nullPtr)
  	if (pRes == nullPtr)
  		then do
***************
*** 205,228 ****
  					return ((name,sqlType,(flags .&. (#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 (#const FIELD_TYPE_NULL)       _    _    = SqlUnknown
  
  -- | 'fetch' fetches the next rowset of data from the result set.
--- 206,236 ----
  					return ((name,sqlType,(flags .&. (#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 (#const FIELD_TYPE_NULL)       _    _    = SqlUnknown
! 
! -- | Executes the statement and returns a 'Statement' value which represents the result set
! query :: Connection -> String -> IO Statement
! query conn@(Connection pMYSQL) query = withStatement conn $ \pMYSQL -> do
! 	res <- withCString query (mysql_query pMYSQL)
! 	when (res /= 0) (handleSqlError pMYSQL)
! 	mysql_use_result pMYSQL
  
  -- | 'fetch' fetches the next rowset of data from the result set.
***************
*** 237,242 ****
  		return (pRow /= nullPtr)
  
! -- | 'closeStatement' stops processing associated with a specific statement, closes any open cursors 
! -- associated with the statement, discards pending results, and frees all resources associated with 
  -- the statement.
  closeStatement :: Statement -> IO ()
--- 245,250 ----
  		return (pRow /= nullPtr)
  
! -- | 'closeStatement' stops processing associated with a specific statement, closes any open cursors
! -- associated with the statement, discards pending results, and frees all resources associated with
  -- the statement.
  closeStatement :: Statement -> IO ()
***************
*** 244,247 ****
--- 252,285 ----
  	| pRes == nullPtr = return ()
  	| otherwise = mysql_free_result pRes
+ 
+ -----------------------------------------------------------------------------------------
+ -- getting table and column info
+ -----------------------------------------------------------------------------------------
+ 
+ -- | List all tables in the database.
+ tables :: Connection -- ^ Database connection
+ 	  -> IO [String] -- ^ The names of all tables in the database.
+ tables conn = do
+       stmt <- withStatement conn list_tables
+       -- SQLTables returns:
+       -- Column name     #   Type
+       -- Tables_in_xx      0   VARCHAR
+       collectRows getTableName stmt
+       where
+             list_tables pMYSQL = mysql_list_tables pMYSQL nullPtr
+ 
+             getTableName (Statement {currRow=currRow, fields=fieldDefs}) = do
+                   (row, lengths) <- readIORef currRow
+                   pValue <- peekElemOff row 0
+                   len <- fmap fromIntegral (peekElemOff lengths 0)
+                   peekCStringLen (pValue, len)
+ 
+ describe :: Connection -- ^ Database connection
+ 	   -> String -- ^ Name of a database table
+ 	   -> IO [(String, SqlType, Bool)] -- ^ @[(name, type, nullable)]@
+ describe conn table = do
+       stmt <- withStatement conn list_fields
+       return (getFieldsTypes stmt)
+       where list_fields pMYSQL = withCString table (\table -> mysql_list_fields pMYSQL table nullPtr)
  
  -----------------------------------------------------------------------------------------

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.15,1.16

From: <kr_...@us...> - 2004-01-05 20:23:30

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv2607/ODBC

Modified Files:
	HSQL.hsc 
Log Message:
Remove debug message


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** HSQL.hsc	5 Jan 2004 19:57:15 -0000	1.15
--- HSQL.hsc	5 Jan 2004 20:23:25 -0000	1.16
***************
*** 372,376 ****
  describe conn table = do
        stmt <- withStatement conn (\hSTMT -> sqlColumns' hSTMT table)
-       print (getFieldsTypes stmt)
        collectRows getColumnInfo stmt
        where
--- 372,375 ----

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.14,1.15

From: <kr_...@us...> - 2004-01-05 19:57:18

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv28793/ODBC

Modified Files:
	HSQL.hsc 
Log Message:
Simplifying stdcall/ccall choice


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** HSQL.hsc	5 Jan 2004 09:25:21 -0000	1.14
--- HSQL.hsc	5 Jan 2004 19:57:15 -0000	1.15
***************
*** 64,110 ****
  type SQLULEN      = SQLINTEGER
  
- 
  #if defined(WINODBC)
! foreign import stdcall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
! foreign import stdcall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
! foreign import stdcall "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLTables" sqlTables :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLColumns" sqlColumns :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
  #else
! foreign import ccall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
! foreign import ccall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
! foreign import ccall "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLTables" sqlTables :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLColumns" sqlColumns :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
  #endif
  
  
  -- | A 'Connection' type represents a connection to a data source, through which you can operate on the data source. 
--- 64,93 ----
  type SQLULEN      = SQLINTEGER
  
  #if defined(WINODBC)
! #let CALLCONV = "stdcall"
  #else
! #let CALLCONV = "ccall"
  #endif
  
+ foreign import #{CALLCONV} "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
+ foreign import #{CALLCONV} "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLTables" sqlTables :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
+ foreign import #{CALLCONV} "HsODBC.h SQLColumns" sqlColumns :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
+ 
  
  -- | A 'Connection' type represents a connection to a data source, through which you can operate on the data source. 
***************
*** 127,131 ****
  type FieldDef = (String, SqlType, Bool)
  
! data SqlType	
  	= SqlChar          Int
  	| SqlVarChar       Int
--- 110,114 ----
  type FieldDef = (String, SqlType, Bool)
  
! data SqlType
  	= SqlChar          Int
  	| SqlVarChar       Int
***************
*** 341,347 ****
  mkSqlType (#const SQL_TIME)         _    	_    = (SqlTime, (#const sizeof(SQL_TIME_STRUCT)))
  mkSqlType (#const SQL_TIMESTAMP)	_    	_    = (SqlTimeStamp, (#const sizeof(SQL_TIMESTAMP_STRUCT)))
! mkSqlType (#const SQL_WCHAR)        size	_    = (SqlWChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
! mkSqlType (#const SQL_WVARCHAR)     size    _    = (SqlWVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
! mkSqlType (#const SQL_WLONGVARCHAR)	size    _    = (SqlWLongVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
  
  
--- 324,330 ----
  mkSqlType (#const SQL_TIME)         _    	_    = (SqlTime, (#const sizeof(SQL_TIME_STRUCT)))
  mkSqlType (#const SQL_TIMESTAMP)	_    	_    = (SqlTimeStamp, (#const sizeof(SQL_TIMESTAMP_STRUCT)))
! mkSqlType (#const SQL_WCHAR)        size	_    = (SqlWChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
! mkSqlType (#const SQL_WVARCHAR)     size    _    = (SqlWVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
! mkSqlType (#const SQL_WLONGVARCHAR)	size    _    = (SqlWLongVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))

[htoolkit-cvs] HSQL/ODBC HsODBC.h,1.1,1.2

From: <kr_...@us...> - 2004-01-05 17:26:22

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv29406/ODBC

Modified Files:
	HsODBC.h 
Log Message:
Add #include <sqlucode.h>. It is realy required only for unixODBC but it is
not bad to include it under Windows


Index: HsODBC.h
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HsODBC.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** HsODBC.h	4 Jan 2004 13:14:58 -0000	1.1
--- HsODBC.h	5 Jan 2004 17:26:19 -0000	1.2
***************
*** 7,10 ****
--- 7,11 ----
  
  #include <sqlext.h>
+ #include <sqlucode.h>
  
  #define FIELD_NAME_LENGTH 255

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.13,1.14

From: <kr_...@us...> - 2004-01-05 09:25:25

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv6605/ODBC

Modified Files:
	HSQL.hsc 
Log Message:
Add support for SqlWChar, SqlWVarChar and SqlWLongVarChar


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** HSQL.hsc	5 Jan 2004 00:41:03 -0000	1.13
--- HSQL.hsc	5 Jan 2004 09:25:21 -0000	1.14
***************
*** 131,134 ****
--- 131,137 ----
  	| SqlVarChar       Int
  	| SqlLongVarChar   Int
+ 	| SqlWChar         Int
+ 	| SqlWVarChar      Int
+ 	| SqlWLongVarChar  Int
  	| SqlDecimal       Int Int
  	| SqlNumeric       Int Int
***************
*** 338,341 ****
--- 341,348 ----
  mkSqlType (#const SQL_TIME)         _    	_    = (SqlTime, (#const sizeof(SQL_TIME_STRUCT)))
  mkSqlType (#const SQL_TIMESTAMP)	_    	_    = (SqlTimeStamp, (#const sizeof(SQL_TIMESTAMP_STRUCT)))
+ mkSqlType (#const SQL_WCHAR)        size	_    = (SqlWChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
+ mkSqlType (#const SQL_WVARCHAR)     size    _    = (SqlWVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
+ mkSqlType (#const SQL_WLONGVARCHAR)	size    _    = (SqlWLongVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
+ 
  
  -- | Executes the statement and returns a 'Statement' value which represents the result set
***************
*** 382,385 ****
--- 389,393 ----
  describe conn table = do
        stmt <- withStatement conn (\hSTMT -> sqlColumns' hSTMT table)
+       print (getFieldsTypes stmt)
        collectRows getColumnInfo stmt
        where
***************
*** 460,463 ****
--- 468,474 ----
  	fromSqlValue (SqlVarChar _) ptr size = fmap Just $ peekCStringLen (castPtr ptr, size)
  	fromSqlValue (SqlLongVarChar _) ptr size = fmap Just $ peekCStringLen (castPtr ptr, size)
+ 	fromSqlValue (SqlWChar _) ptr size = fmap Just $ peekCStringLen (castPtr ptr, size)
+ 	fromSqlValue (SqlWVarChar _) ptr size = fmap Just $ peekCStringLen (castPtr ptr, size)
+ 	fromSqlValue (SqlWLongVarChar _) ptr size = fmap Just $ peekCStringLen (castPtr ptr, size)
  	fromSqlValue _ _ _ = return Nothing
  	
***************
*** 562,569 ****
  			SqlBigInt          -> (#const SQL_C_CHAR)
  			SqlChar _          -> (#const SQL_C_CHAR)
! 			SqlVarChar _       -> (#const SQL_C_CHAR)			
  			SqlBinary _		   -> (#const SQL_C_BINARY)
  			SqlVarBinary _     -> (#const SQL_C_BINARY)
  			SqlLongVarChar _   -> (#const SQL_C_CHAR)
  			SqlLongVarBinary _ -> (#const SQL_C_BINARY)
  
--- 573,583 ----
  			SqlBigInt          -> (#const SQL_C_CHAR)
  			SqlChar _          -> (#const SQL_C_CHAR)
! 			SqlVarChar _       -> (#const SQL_C_CHAR)
! 			SqlWChar _         -> (#const SQL_C_CHAR)
! 			SqlWVarChar _      -> (#const SQL_C_CHAR)
  			SqlBinary _		   -> (#const SQL_C_BINARY)
  			SqlVarBinary _     -> (#const SQL_C_BINARY)
  			SqlLongVarChar _   -> (#const SQL_C_CHAR)
+ 			SqlWLongVarChar _  -> (#const SQL_C_CHAR)
  			SqlLongVarBinary _ -> (#const SQL_C_BINARY)

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.12,1.13

From: <kr_...@us...> - 2004-01-05 00:41:07

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv26990a/ODBC

Modified Files:
	HSQL.hsc 
Log Message:
Add tables and describe functions for ODBC backend


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** HSQL.hsc	4 Jan 2004 16:43:29 -0000	1.12
--- HSQL.hsc	5 Jan 2004 00:41:03 -0000	1.13
***************
*** 32,35 ****
--- 32,37 ----
  		, forEachRow'       -- :: (Statement -> IO ()) -> Statement -> IO ()
  		, collectRows       -- :: (Statement -> IO s) -> Statement -> IO [s]
+ 		, tables            -- :: Connection -> IO [String]
+ 		, describe          -- :: Connection -> String -> IO [(String, SqlType, Bool)]
  		) where
  
***************
*** 81,84 ****
--- 83,88 ----
  foreign import stdcall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
  foreign import stdcall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLTables" sqlTables :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLColumns" sqlColumns :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
  #else
  foreign import ccall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
***************
*** 99,102 ****
--- 103,108 ----
  foreign import ccall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
  foreign import ccall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ foreign import ccall "HsODBC.h SQLTables" sqlTables :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
+ foreign import ccall "HsODBC.h SQLColumns" sqlColumns :: HSTMT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> CString -> SQLSMALLINT -> IO SQLRETURN
  #endif
  
***************
*** 181,185 ****
  
  sqlSuccess :: SQLRETURN -> Bool
! sqlSuccess res = 
  	(res == (#const SQL_SUCCESS)) || (res == (#const SQL_SUCCESS_WITH_INFO)) || (res == (#const SQL_NO_DATA))
  
--- 187,191 ----
  
  sqlSuccess :: SQLRETURN -> Bool
! sqlSuccess res =
  	(res == (#const SQL_SUCCESS)) || (res == (#const SQL_SUCCESS_WITH_INFO)) || (res == (#const SQL_NO_DATA))
  
***************
*** 255,259 ****
  	sqlFreeConnect hDBC >>= handleSqlResult (#const SQL_HANDLE_DBC) hDBC
  	return ()
! 	
  -----------------------------------------------------------------------------------------
  -- queries
--- 261,265 ----
  	sqlFreeConnect hDBC >>= handleSqlResult (#const SQL_HANDLE_DBC) hDBC
  	return ()
! 
  -----------------------------------------------------------------------------------------
  -- queries
***************
*** 278,285 ****
  	free pFIELD
  
! -- | Executes the statement and returns a 'Statement' value which represents the result set
! query :: Connection -> String -> IO Statement
! query conn@(Connection {hDBC=hDBC}) query = do
! 	pFIELD <- mallocBytes (#const sizeof(FIELD))	
  	res <- sqlAllocStmt hDBC ((#ptr FIELD, hSTMT) pFIELD)
  	unless (sqlSuccess res) (free pFIELD)
--- 284,290 ----
  	free pFIELD
  
! withStatement :: Connection -> (HSTMT -> IO SQLRETURN) -> IO Statement
! withStatement conn@(Connection {hDBC=hDBC}) f = do
! 	pFIELD <- mallocBytes (#const sizeof(FIELD))
  	res <- sqlAllocStmt hDBC ((#ptr FIELD, hSTMT) pFIELD)
  	unless (sqlSuccess res) (free pFIELD)
***************
*** 289,296 ****
  		unless (sqlSuccess res) (free pFIELD)
  		handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 	pQuery <- newCString query
! 	res <- sqlExecDirect hSTMT pQuery (length query)
! 	free pQuery
! 	handleResult res
  	sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult
  	count <- (#peek FIELD, fieldsCount) pFIELD
--- 294,298 ----
  		unless (sqlSuccess res) (free pFIELD)
  		handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res
! 	res <- f hSTMT >>= handleResult
  	sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult
  	count <- (#peek FIELD, fieldsCount) pFIELD
***************
*** 316,340 ****
  				(fields, fullBufSize) <- getFieldDefs hSTMT pFIELD (n+1) count
  				return ((name,sqlType,toBool nullable):fields, max bufSize fullBufSize)
- 				
- 		mkSqlType :: SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> (SqlType, SQLINTEGER)
- 		mkSqlType (#const SQL_CHAR)         size    _    = (SqlChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
- 		mkSqlType (#const SQL_VARCHAR)      size    _    = (SqlVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
- 		mkSqlType (#const SQL_LONGVARCHAR)  size    _    = (SqlLongVarChar (fromIntegral size), 1) -- dummy bufSize
- 		mkSqlType (#const SQL_DECIMAL)      size    prec = (SqlDecimal (fromIntegral size) (fromIntegral prec), (#const sizeof(SQLDOUBLE)))
- 		mkSqlType (#const SQL_NUMERIC)      size    prec = (SqlNumeric (fromIntegral size) (fromIntegral prec), (#const sizeof(SQLDOUBLE)))
- 		mkSqlType (#const SQL_SMALLINT)     _       _    = (SqlSmallInt, (#const sizeof(SQLSMALLINT)))
- 		mkSqlType (#const SQL_INTEGER)      _       _    = (SqlInteger, (#const sizeof(SQLINTEGER)))
- 		mkSqlType (#const SQL_REAL)         _       _    = (SqlReal, (#const sizeof(SQLDOUBLE)))
- 		mkSqlType (#const SQL_DOUBLE)		_    	_    = (SqlDouble, (#const sizeof(SQLDOUBLE)))
- 		mkSqlType (#const SQL_BIT)          _    	_    = (SqlBit, (#const sizeof(SQLINTEGER)))
- 		mkSqlType (#const SQL_TINYINT)      _    	_    = (SqlTinyInt, (#const sizeof(SQLSMALLINT)))
- 		mkSqlType (#const SQL_BIGINT)       _    	_    = (SqlBigInt, (#const sizeof(SQLINTEGER)))
- 		mkSqlType (#const SQL_BINARY)       size    _    = (SqlBinary (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
- 		mkSqlType (#const SQL_VARBINARY)    size    _    = (SqlVarBinary (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
- 		mkSqlType (#const SQL_LONGVARBINARY)size    _    = (SqlLongVarBinary (fromIntegral size), 1) -- dummy bufSize
- 		mkSqlType (#const SQL_DATE)         _    	_    = (SqlDate, (#const sizeof(SQL_DATE_STRUCT)))
- 		mkSqlType (#const SQL_TIME)         _    	_    = (SqlTime, (#const sizeof(SQL_TIME_STRUCT)))
- 		mkSqlType (#const SQL_TIMESTAMP)	_    	_    = (SqlTimeStamp, (#const sizeof(SQL_TIMESTAMP_STRUCT)))
  
  
  {-# NOINLINE fetch #-}
--- 318,346 ----
  				(fields, fullBufSize) <- getFieldDefs hSTMT pFIELD (n+1) count
  				return ((name,sqlType,toBool nullable):fields, max bufSize fullBufSize)
  
+ mkSqlType :: SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> (SqlType, SQLINTEGER)
+ mkSqlType (#const SQL_CHAR)         size    _    = (SqlChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
+ mkSqlType (#const SQL_VARCHAR)      size    _    = (SqlVarChar (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
+ mkSqlType (#const SQL_LONGVARCHAR)  size    _    = (SqlLongVarChar (fromIntegral size), 1) -- dummy bufSize
+ mkSqlType (#const SQL_DECIMAL)      size    prec = (SqlDecimal (fromIntegral size) (fromIntegral prec), (#const sizeof(SQLDOUBLE)))
+ mkSqlType (#const SQL_NUMERIC)      size    prec = (SqlNumeric (fromIntegral size) (fromIntegral prec), (#const sizeof(SQLDOUBLE)))
+ mkSqlType (#const SQL_SMALLINT)     _       _    = (SqlSmallInt, (#const sizeof(SQLSMALLINT)))
+ mkSqlType (#const SQL_INTEGER)      _       _    = (SqlInteger, (#const sizeof(SQLINTEGER)))
+ mkSqlType (#const SQL_REAL)         _       _    = (SqlReal, (#const sizeof(SQLDOUBLE)))
+ mkSqlType (#const SQL_DOUBLE)		_    	_    = (SqlDouble, (#const sizeof(SQLDOUBLE)))
+ mkSqlType (#const SQL_BIT)          _    	_    = (SqlBit, (#const sizeof(SQLINTEGER)))
+ mkSqlType (#const SQL_TINYINT)      _    	_    = (SqlTinyInt, (#const sizeof(SQLSMALLINT)))
+ mkSqlType (#const SQL_BIGINT)       _    	_    = (SqlBigInt, (#const sizeof(SQLINTEGER)))
+ mkSqlType (#const SQL_BINARY)       size    _    = (SqlBinary (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
+ mkSqlType (#const SQL_VARBINARY)    size    _    = (SqlVarBinary (fromIntegral size), (#const sizeof(SQLCHAR))*(fromIntegral size+1))
+ mkSqlType (#const SQL_LONGVARBINARY)size    _    = (SqlLongVarBinary (fromIntegral size), 1) -- dummy bufSize
+ mkSqlType (#const SQL_DATE)         _    	_    = (SqlDate, (#const sizeof(SQL_DATE_STRUCT)))
+ mkSqlType (#const SQL_TIME)         _    	_    = (SqlTime, (#const sizeof(SQL_TIME_STRUCT)))
+ mkSqlType (#const SQL_TIMESTAMP)	_    	_    = (SqlTimeStamp, (#const sizeof(SQL_TIMESTAMP_STRUCT)))
+ 
+ -- | Executes the statement and returns a 'Statement' value which represents the result set
+ query :: Connection -> String -> IO Statement
+ query conn q = withStatement conn doQuery
+     where doQuery hSTMT = withCStringLen q (uncurry (sqlExecDirect hSTMT))
  
  {-# NOINLINE fetch #-}
***************
*** 346,352 ****
  	handleSqlResult (#const SQL_HANDLE_STMT) (hSTMT stmt) res
  	return (res /= (#const SQL_NO_DATA))
! 	
! -- | 'closeStatement' stops processing associated with a specific statement, closes any open cursors 
! -- associated with the statement, discards pending results, and frees all resources associated with 
  -- the statement.
  closeStatement :: Statement -> IO ()
--- 352,358 ----
  	handleSqlResult (#const SQL_HANDLE_STMT) (hSTMT stmt) res
  	return (res /= (#const SQL_NO_DATA))
! 
! -- | 'closeStatement' stops processing associated with a specific statement, closes any open cursors
! -- associated with the statement, discards pending results, and frees all resources associated with
  -- the statement.
  closeStatement :: Statement -> IO ()
***************
*** 356,359 ****
--- 362,409 ----
  
  -----------------------------------------------------------------------------------------
+ -- getting table and column info
+ -----------------------------------------------------------------------------------------
+ 
+ -- | List all tables in the database.
+ tables :: Connection -- ^ Database connection
+ 	  -> IO [String] -- ^ The names of all tables in the database.
+ tables conn = do
+       stmt <- withStatement conn sqlTables'
+       -- SQLTables returns:
+       -- Column name     #   Type
+       -- TABLE_NAME      3   VARCHAR
+       collectRows (\s -> getFieldValue' s "TABLE_NAME" "") stmt
+       where sqlTables' hSTMT = sqlTables hSTMT nullPtr 0 nullPtr 0 nullPtr 0 nullPtr 0
+ 
+ -- | List all columns in a table along with their types and @nullable@ flags
+ describe :: Connection -- ^ Database connection
+ 	   -> String -- ^ Name of a database table
+ 	   -> IO [(String, SqlType, Bool)] -- ^ @[(name, type, nullable)]@
+ describe conn table = do
+       stmt <- withStatement conn (\hSTMT -> sqlColumns' hSTMT table)
+       collectRows getColumnInfo stmt
+       where
+       sqlColumns' hSTMT table =
+ 	  withCStringLen table (\(pTable,len) ->
+ 	      sqlColumns hSTMT nullPtr 0 nullPtr 0 pTable (fromIntegral len) nullPtr 0)
+       -- SQLColumns returns:
+       -- Column name     #   Type
+       -- COLUMN_NAME     4   Varchar not NULL
+       -- DATA_TYPE       5   Smallint not NULL
+       -- COLUMN_SIZE     7   Integer
+       -- DECIMAL_DIGITS  9   Smallint
+       -- NULLABLE       11   Smallint not NULL
+       getColumnInfo stmt =
+ 	  do
+ 	  name <- getFieldValue stmt "COLUMN_NAME"
+ 	  (t::Int) <- getFieldValue stmt "DATA_TYPE"
+ 	  (size::Int) <- getFieldValue' stmt "COLUMN_SIZE" 0
+ 	  (prec::Int) <- getFieldValue' stmt "DECIMAL_DIGITS" 0
+ 	  (n::Int) <- getFieldValue stmt "NULLABLE"
+ 	  let (sqlType,_) = mkSqlType (fromIntegral t) (fromIntegral size) (fromIntegral prec)
+ 	      nullable = n /= (#const SQL_NO_NULLS)
+ 	  return (name, sqlType, nullable)
+ 
+ -----------------------------------------------------------------------------------------
  -- transactions
  -----------------------------------------------------------------------------------------
***************
*** 391,395 ****
  	
  	toSqlValue val = show val
! 		
  instance SqlBind Integer where
  	fromSqlValue SqlInteger ptr size = do
--- 441,445 ----
  	
  	toSqlValue val = show val
! 
  instance SqlBind Integer where
  	fromSqlValue SqlInteger ptr size = do

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.11,1.12

From: <kr_...@us...> - 2004-01-04 16:43:40

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv1357/ODBC

Modified Files:
	HSQL.hsc 
Log Message:
hsc2hs doesn't recognize the trick with "#define ccall stdcall".
The solution is to duplicate all FFI declarations


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** HSQL.hsc	4 Jan 2004 16:03:52 -0000	1.11
--- HSQL.hsc	4 Jan 2004 16:43:29 -0000	1.12
***************
*** 62,69 ****
  type SQLULEN      = SQLINTEGER
  
- #ifdef WINODBC
- #define ccall stdcall
- #endif
  
  foreign import ccall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
  foreign import ccall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
--- 62,85 ----
  type SQLULEN      = SQLINTEGER
  
  
+ #if defined(WINODBC)
+ foreign import stdcall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
+ foreign import stdcall "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
+ foreign import stdcall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ #else
  foreign import ccall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
  foreign import ccall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
***************
*** 83,86 ****
--- 99,103 ----
  foreign import ccall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
  foreign import ccall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
+ #endif

[htoolkit-cvs] HSQL configure.ac,1.6,1.7

From: <kr_...@us...> - 2004-01-04 16:25:04

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1:/tmp/cvs-serv30892

Modified Files:
	configure.ac 
Log Message:
bugfix


Index: configure.ac
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/configure.ac,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** configure.ac	4 Jan 2004 13:14:54 -0000	1.6
--- configure.ac	4 Jan 2004 16:25:00 -0000	1.7
***************
*** 67,71 ****
  ],
  [GHC_DIR="$withval"],
! [GHC_DIR=`$GHC --print-libdir`]
  )
  
--- 67,73 ----
  ],
  [GHC_DIR="$withval"],
! [if test "$GHC" != ""; then
!    GHC_DIR=`$GHC --print-libdir`
!  fi]
  )
  
***************
*** 142,149 ****
  AC_ARG_WITH(hugs-dir,
  [  --with-hugs-dir=<hugs directory>
!         Install Hugs libraries in the given Hugs directory (default is the path to hugs)
  ],
  [HUGS_DIR="$withval"],
! [HUGS_DIR=$(dirname $HUGS)]
  )
  
--- 144,157 ----
  AC_ARG_WITH(hugs-dir,
  [  --with-hugs-dir=<hugs directory>
!         Install Hugs libraries in the given Hugs directory (default is the Hugs libraries directory)
  ],
  [HUGS_DIR="$withval"],
! [if test "$HUGS" != ""; then
!    case $ac_cv_target_alias in
!       i[[3456]]86-*-cygwin*|i[[3456]]86-*-mingw32*)
!           HUGS_DIR=$(dirname $HUGS);;
!       *)  HUGS_DIR=$(dirname $HUGS)/../lib/hugs;;
!    esac
!  fi]
  )
  
***************
*** 226,230 ****
          }
          ],
!         [LDFLAGS="${LDFLAGS} -lodbc32"],
          AC_MSG_ERROR([sqlext.h and libodbc required to build ODBC building.]))
          CPPFLAGS="$CPPFLAGS -DWINODBC"
--- 234,238 ----
          }
          ],
!         [LIBS="${LIBS} -lodbc32"],
          AC_MSG_ERROR([sqlext.h and libodbc required to build ODBC building.]))
          CPPFLAGS="$CPPFLAGS -DWINODBC"
***************
*** 291,294 ****
--- 299,303 ----
  dnl ***********************************************
  
+ LDFLAGS="${LIBS} ${LDFLAGS}"
  LIB_DIRS='"'${GHC_DIR}'"'

[htoolkit-cvs] HSQL/ODBC HSQL.hsc,1.10,1.11

From: <kr_...@us...> - 2004-01-04 16:03:58

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv26759/ODBC

Modified Files:
	HSQL.hsc 
Log Message:
Use stdcall calling convention only for WINODBC


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** HSQL.hsc	4 Jan 2004 13:14:58 -0000	1.10
--- HSQL.hsc	4 Jan 2004 16:03:52 -0000	1.11
***************
*** 62,82 ****
  type SQLULEN      = SQLINTEGER
  
! foreign import stdcall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
! foreign import stdcall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
! foreign import stdcall "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
  
  
--- 62,86 ----
  type SQLULEN      = SQLINTEGER
  
! #ifdef WINODBC
! #define ccall stdcall
! #endif
! 
! foreign import ccall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
! foreign import ccall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
! foreign import ccall "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
! foreign import ccall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN

[htoolkit-cvs] HSQL/ODBC HsODBC.h,NONE,1.1 HSQL.hsc,1.9,1.10 HSQLStructs.h,1.1,NONE

From: <kr_...@us...> - 2004-01-04 13:15:15

Update of /cvsroot/htoolkit/HSQL/ODBC
In directory sc8-pr-cvs1:/tmp/cvs-serv27195/ODBC

Modified Files:
	HSQL.hsc 
Added Files:
	HsODBC.h 
Removed Files:
	HSQLStructs.h 
Log Message:
Make the HSQL package compatible with Hugs


--- NEW FILE: HsODBC.h ---
#ifndef HsODBC
#define HsODBC

#if defined(WINODBC)
#include <windows.h>
#endif

#include <sqlext.h>

#define FIELD_NAME_LENGTH 255

typedef struct
	{
		HSTMT hSTMT;
		SQLUSMALLINT fieldsCount;
		SQLCHAR fieldName[FIELD_NAME_LENGTH];
		SQLSMALLINT NameLength;
        SQLSMALLINT DataType;
		SQLULEN ColumnSize;
        SQLSMALLINT DecimalDigits;
		SQLSMALLINT Nullable;
	} FIELD;

#endif

Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/ODBC/HSQL.hsc,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** HSQL.hsc	4 Jan 2004 10:22:34 -0000	1.9
--- HSQL.hsc	4 Jan 2004 13:14:58 -0000	1.10
***************
*** 40,44 ****
  import Foreign
  import Foreign.C
- import qualified Foreign.Concurrent as C
  import Control.Monad(when,unless)
  import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..), finally)
--- 40,43 ----
***************
*** 47,51 ****
  
  #include <time.h>
! #include <HSQLStructs.h>
  
  type SQLHANDLE = Ptr ()
--- 46,50 ----
  
  #include <time.h>
! #include <HsODBC.h>
  
  type SQLHANDLE = Ptr ()
***************
*** 63,83 ****
  type SQLULEN      = SQLINTEGER
  
! foreign import stdcall "sqlext.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLFreeEnv" sqlFreeEnv :: HENV -> IO ()
! foreign import stdcall "sqlext.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "sqlext.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
  
  
--- 62,82 ----
  type SQLULEN      = SQLINTEGER
  
! foreign import stdcall "HsODBC.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN
! foreign import stdcall "HsODBC.h &SQLFreeEnv" sqlFreeEnv_p :: FunPtr (HENV -> IO ())
! foreign import stdcall "HsODBC.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN
! foreign import stdcall "HsODBC.h SQLGetData" sqlGetData :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr () -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLRETURN
  
  
***************
*** 139,143 ****
     		{ seFieldName :: String
  		}
!    deriving (Show, Typeable)
     
  -----------------------------------------------------------------------------------------
--- 138,148 ----
     		{ seFieldName :: String
  		}
!    deriving Show
!    
! sqlErrorTc :: TyCon
! sqlErrorTc = mkTyCon "Database.ODBC.HSQL.SqlError"
! 
! instance Typeable SqlError where
! 	typeOf _ = mkAppTy sqlErrorTc []
     
  -----------------------------------------------------------------------------------------
***************
*** 196,200 ****
  	free phEnv
  	handleSqlResult 0 nullPtr res
! 	C.newForeignPtr hEnv (sqlFreeEnv hEnv)
  
  -----------------------------------------------------------------------------------------
--- 201,205 ----
  	free phEnv
  	handleSqlResult 0 nullPtr res
! 	newForeignPtr sqlFreeEnv_p hEnv
  
  -----------------------------------------------------------------------------------------

--- HSQLStructs.h DELETED ---

221 messages has been excluded from this view by a project administrator.

Flat | Threaded

<< < 1 .. 13 14 15 16 17 .. 47 > >> (Page 15 of 47)