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

[<br...@us...>]

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