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

[<kr_...@us...>]

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