[htoolkit-cvs] HSQL/HSQL/Database HSQL.hsc,1.8,1.9

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

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

Modified Files:
	HSQL.hsc 
Log Message:
possible framework for prepared statements


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** HSQL.hsc	3 Jan 2006 22:59:46 -0000	1.8
--- HSQL.hsc	4 Jan 2006 21:00:09 -0000	1.9
***************
*** 22,32 ****
  	-- the functions described here are used to perform SQL queries and commands.
  	, execute           -- :: Connection -> String -> IO Integer
  	, Statement
  	, query             -- :: Connection -> String -> IO Statement
  	, closeStatement    -- :: Statement -> IO ()
  	, fetch             -- :: Statement -> IO Bool
  	
  	-- * Retrieving Statement values and types
! 	, FieldDef, SqlType(..), SqlBind, toSqlValue
  	, getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
  	, getFieldValue'    -- :: SqlBind a => Statement -> String -> a -> IO a
--- 22,34 ----
  	-- the functions described here are used to perform SQL queries and commands.
  	, execute           -- :: Connection -> String -> IO Integer
+ 	, prepare           -- :: Connection -> String -> IO Integer
  	, Statement
  	, query             -- :: Connection -> String -> IO Statement
  	, closeStatement    -- :: Statement -> IO ()
+ 	, executePrepared   -- :: Statement -> IO ()
  	, fetch             -- :: Statement -> IO Bool
  	
  	-- * Retrieving Statement values and types
! 	, FieldDef, SqlType(..), SqlValue(..), SqlBind, toSqlValue
  	, getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
  	, getFieldValue'    -- :: SqlBind a => Statement -> String -> a -> IO a
***************
*** 113,119 ****
  execute :: Connection  -- ^ the database connection
          -> String      -- ^ the text of SQL command
!         -> IO Integer
  execute conn query = checkHandle (connClosed conn) (connExecute conn query)
  
  -- | Executes a query and returns a result set
  query :: Connection    -- ^ the database connection
--- 115,127 ----
  execute :: Connection  -- ^ the database connection
          -> String      -- ^ the text of SQL command
!         -> IO Integer  -- ^ returns the number of affected rows
  execute conn query = checkHandle (connClosed conn) (connExecute conn query)
  
+ -- | Submits a command to the database.
+ prepare :: Connection  -- ^ the database connection
+         -> String      -- ^ the text of SQL command
+         -> IO Statement
+ prepare conn query = checkHandle (connClosed conn) (connPrepare conn query)
+ 
  -- | Executes a query and returns a result set
  query :: Connection    -- ^ the database connection
***************
*** 160,163 ****
--- 168,178 ----
  -- | 'fetch' fetches the next rowset of data from the result set.
  -- The values from columns can be retrieved with 'getFieldValue' function.
+ executePrepared :: Statement -> [SqlValue] -> IO ()
+ executePrepared stmt values = checkHandle (stmtClosed stmt) $ do
+   mapM_ (stmtSetParam stmt) values
+   stmtExecute stmt
+ 
+ -- | 'fetch' fetches the next rowset of data from the result set.
+ -- The values from columns can be retrieved with 'getFieldValue' function.
  fetch :: Statement -> IO Bool
  fetch stmt = checkHandle (stmtClosed stmt) (stmtFetch stmt)
***************
*** 276,279 ****
--- 291,295 ----
  
  	toSqlValue s = show s
+ 
  instance SqlBind String where
  	fromSqlValue _ = Just
***************
*** 553,556 ****
--- 569,603 ----
  			showHex = showIntAtBase 16 intToDigit
  
+ instance SqlBind SqlValue where
+   fromSqlCStringLen (name,sqlType,_) cstr cstrLen
+     | cstr == nullPtr = return SqlNullValue
+     | otherwise       = do 
+     	str <- peekCStringLen (cstr, cstrLen)
+     	case fromSqlValue sqlType str of
+     	  Nothing -> throwDyn (SqlBadTypeCast name sqlType)
+ 	  Just v  -> return v
+ 
+   fromSqlValue SqlInteger       s = Just $! SqlIntValue    $! read s
+   fromSqlValue SqlMedInt        s = Just $! SqlIntValue    $! read s
+   fromSqlValue SqlTinyInt       s = Just $! SqlIntValue    $! read s
+   fromSqlValue SqlSmallInt      s = Just $! SqlIntValue    $! read s
+   fromSqlValue SqlBigInt        s = Just $! SqlIntValue    $! read s
+   fromSqlValue (SqlDecimal _ _) s = Just $! SqlDoubleValue $! read s
+   fromSqlValue (SqlNumeric _ _) s = Just $! SqlDoubleValue $! read s
+   fromSqlValue SqlDouble        s = Just $! SqlDoubleValue $! read s
+   fromSqlValue SqlReal          s = Just $! SqlDoubleValue $! read s
+   fromSqlValue SqlFloat         s = Just $! SqlDoubleValue $! read s
+   fromSqlValue SqlBit           s = Just $! SqlBoolValue   $! (s == "t")
+   fromSqlValue tp               s = Just $!
+     case fromSqlValue tp s of
+       Just t  -> SqlClockTimeValue t
+       Nothing -> SqlStringValue    s
+       
+   toSqlValue (SqlIntValue       v) = toSqlValue v
+   toSqlValue (SqlDoubleValue    v) = toSqlValue v
+   toSqlValue (SqlBoolValue      v) = toSqlValue v
+   toSqlValue (SqlClockTimeValue v) = toSqlValue v
+   toSqlValue (SqlStringValue    v) = toSqlValue v
+ 
  -- | Retrieves the value of column with the specified name.
  getFieldValue :: SqlBind a => Statement