[htoolkit-cvs] HSQL/SQLite3/Database/HSQL SQLite3.hsc,1.4,1.5

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

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

Modified Files:
	SQLite3.hsc 
Log Message:
support for prepared statements in SQLite3


Index: SQLite3.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL/SQLite3.hsc,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** SQLite3.hsc	4 Jan 2006 08:23:59 -0000	1.4
--- SQLite3.hsc	9 Jan 2006 12:45:04 -0000	1.5
***************
*** 27,30 ****
--- 27,31 ----
  
  type SQLite3 = Ptr ()
+ type SQLite3Stmt = Ptr ()
  
  foreign import ccall sqlite3_open :: CString -> (Ptr SQLite3) -> IO Int
***************
*** 32,36 ****
--- 33,49 ----
  foreign import ccall sqlite3_close :: SQLite3 -> IO ()
  foreign import ccall sqlite3_exec :: SQLite3 -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO CInt
+ foreign import ccall sqlite3_prepare :: SQLite3 -> CString -> CInt -> Ptr SQLite3Stmt -> Ptr CString -> IO CInt
+ foreign import ccall sqlite3_finalize :: SQLite3Stmt -> IO CInt
+ foreign import ccall sqlite3_step :: SQLite3Stmt -> IO CInt
+ foreign import ccall sqlite3_reset :: SQLite3Stmt -> IO CInt
  foreign import ccall sqlite3_changes :: SQLite3 -> IO CInt
+ foreign import ccall sqlite3_column_count :: SQLite3Stmt -> IO CInt
+ foreign import ccall sqlite3_column_name :: SQLite3Stmt -> CInt -> IO CString
+ foreign import ccall sqlite3_column_text :: SQLite3Stmt -> CInt -> IO CString
+ foreign import ccall sqlite3_bind_double :: SQLite3Stmt -> CInt -> Double -> IO CInt
+ foreign import ccall sqlite3_bind_int :: SQLite3Stmt -> CInt -> CInt -> IO CInt
+ foreign import ccall sqlite3_bind_int64 :: SQLite3Stmt -> CInt -> Int64 -> IO CInt
+ foreign import ccall sqlite3_bind_null :: SQLite3Stmt -> CInt -> IO CInt
+ foreign import ccall sqlite3_bind_text :: SQLite3Stmt -> CInt -> CString -> CInt -> CInt -> IO CInt
  foreign import ccall sqlite3_get_table ::   SQLite3 -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CInt -> Ptr CString -> IO CInt
  foreign import ccall sqlite3_free_table :: Ptr CString -> IO ()
***************
*** 43,54 ****
  -----------------------------------------------------------------------------------------
  
! handleSqlResult :: CInt -> Ptr CString -> IO ()
! handleSqlResult res ppMsg
  	| res == (#const SQLITE_OK) = return ()
  	| otherwise = do
! 		pMsg <- peek ppMsg
! 		msg <- peekCString pMsg
! 		sqlite3_free pMsg
! 		throwDyn (SqlError "E" (fromIntegral res) msg)
  
  -----------------------------------------------------------------------------------------
--- 56,67 ----
  -----------------------------------------------------------------------------------------
  
! handleSqlResult :: SQLite3 -> CInt -> IO ()
! handleSqlResult sqlite res
  	| res == (#const SQLITE_OK) = return ()
  	| otherwise = do
!             pMsg <- sqlite3_errmsg sqlite
!             msg <- peekCString pMsg
!             sqlite3_free pMsg
!             throwDyn (SqlError "E" (fromIntegral res) msg)
  
  -----------------------------------------------------------------------------------------
***************
*** 67,71 ****
  			throwDyn (SqlError
  			            { seState = "C"
! 			            , seNativeError = 0
  			            , seErrorMsg = msg
  			            })
--- 80,84 ----
  			throwDyn (SqlError
  			            { seState = "C"
! 			            , seNativeError = res
  			            , seErrorMsg = msg
  			            })
***************
*** 75,78 ****
--- 88,92 ----
  			, connClosed     = refFalse
  			, connExecute    = execute sqlite
+ 			, connPrepare    = prepare connection sqlite
  			, connQuery      = query connection sqlite
  			, connTables     = tables connection sqlite
***************
*** 92,133 ****
  		execute :: SQLite3 -> String -> IO Integer
  		execute sqlite query =
! 			withCString query $ \pQuery -> do
! 			alloca $ \ppMsg -> do
! 				res <- sqlite3_exec sqlite pQuery nullFunPtr nullPtr ppMsg
! 				handleSqlResult res ppMsg
! 				changes <- sqlite3_changes sqlite
! 				return $! fromIntegral changes
  
  		query :: Connection -> SQLite3 -> String -> IO Statement
! 		query connection sqlite query = do
! 			withCString query $ \pQuery -> do
! 			alloca $ \ppResult -> do
! 			alloca $ \pnRow -> do
! 			alloca $ \pnColumn -> do
! 			alloca $ \ppMsg -> do
! 				res <- sqlite3_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg
! 				handleSqlResult res ppMsg
! 				pResult <- peek ppResult
! 				rows    <- fmap fromIntegral (peek pnRow)
! 				columns <- fmap fromIntegral (peek pnColumn)
! 				defs <- getFieldDefs pResult 0 columns
! 				refFalse <- newMVar False
! 				refIndex <- newMVar 0
! 				return (Statement
! 				              { stmtConn   = connection
! 				              , stmtClose  = sqlite3_free_table pResult
! 				              , stmtFetch  = fetch refIndex rows
! 				              , stmtGetCol = getColValue pResult refIndex columns rows
! 				              , stmtFields = defs
! 				              , stmtClosed = refFalse
! 				              })
! 			where
! 				getFieldDefs :: Ptr CString -> Int -> Int -> IO [FieldDef]
! 				getFieldDefs pResult index count
! 					| index >= count = return []
! 					| otherwise         = do
! 						name <- peekElemOff pResult index >>= peekCString
! 						defs <- getFieldDefs pResult (index+1) count
! 						return ((name,SqlText,True):defs)
  
  		tables :: Connection -> SQLite3 -> IO [String]
--- 106,162 ----
  		execute :: SQLite3 -> String -> IO Integer
  		execute sqlite query =
! 		  withCString query $ \pQuery -> do
! 		    sqlite3_exec sqlite pQuery nullFunPtr nullPtr nullPtr >>= handleSqlResult sqlite
! 		    changes <- sqlite3_changes sqlite
! 		    return $! fromIntegral changes
! 
! 		prepare :: Connection -> SQLite3 -> String -> IO Statement
! 		prepare connection sqlite query =
! 		  withCString query $ \cstr ->
! 		  alloca $ \ppStmt -> do
! 		    sqlite3_prepare sqlite cstr (-1) ppStmt nullPtr >>= handleSqlResult sqlite
! 		    stmt <- peek ppStmt
! 		    count <- sqlite3_column_count stmt
! 		    defs <- getFieldDefs stmt 0 count
! 		    refFalse <- newMVar False
! 		    return (Statement
! 		    		{ stmtConn   = connection
! 		    		, stmtClose  = sqlite3_finalize stmt >>= handleSqlResult sqlite
! 		    		, stmtExecute= return (-1)
! 		    		, stmtReset  = sqlite3_reset stmt >>= handleSqlResult sqlite
! 		    		, stmtSetParam=setParam sqlite stmt
! 		    		, stmtFetch  = fetch stmt
! 		    		, stmtGetCol = getColValue stmt
! 		    		, stmtFields = defs
! 		    		, stmtClosed = refFalse
! 				})
  
  		query :: Connection -> SQLite3 -> String -> IO Statement
! 		query connection sqlite query =
! 		  withCString query $ \cstr ->
! 		  alloca $ \ppStmt -> do
! 		    sqlite3_prepare sqlite cstr (-1) ppStmt nullPtr >>= handleSqlResult sqlite
! 		    stmt <- peek ppStmt
! 		    count <- sqlite3_column_count stmt
! 		    defs <- getFieldDefs stmt 0 count
! 		    refFalse <- newMVar False
! 		    return (Statement
! 				{ stmtConn   = connection
! 				, stmtClose  = sqlite3_finalize stmt >>= handleSqlResult sqlite
! 				, stmtExecute= throwDyn SqlUnsupportedOperation
! 				, stmtReset  = throwDyn SqlUnsupportedOperation
! 				, stmtSetParam=throwDyn SqlUnsupportedOperation
! 				, stmtFetch  = fetch stmt
! 				, stmtGetCol = getColValue stmt
! 				, stmtFields = defs
! 				, stmtClosed = refFalse
! 				})
! 
! 		getFieldDefs :: SQLite3Stmt -> CInt -> CInt -> IO [FieldDef]
! 		getFieldDefs stmt index count
! 		  | index >= count = return []
! 		  | otherwise      = do name <- sqlite3_column_name stmt index >>= peekCString
! 		                        defs <- getFieldDefs stmt (index+1) count
! 		                        return ((name,SqlText,True):defs)
  
  		tables :: Connection -> SQLite3 -> IO [String]
***************
*** 146,158 ****
  					return (name, SqlText, notnull=="0")
  
! 		fetch tupleIndex countTuples =
! 			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples))
  
! 		getColValue pResult refIndex columns rows colNumber fieldDef f = do
! 			index <- readMVar refIndex
! 			when (index > rows) (throwDyn SqlNoData)
! 			pStr <- peekElemOff pResult (columns*index+colNumber)
! 			if pStr == nullPtr
! 			  then f fieldDef pStr 0
! 			  else do strLen <- strlen pStr
! 				  f fieldDef pStr (fromIntegral strLen)
--- 175,206 ----
  					return (name, SqlText, notnull=="0")
  
! 		fetch stmt = do
! 		  res <- sqlite3_step stmt
! 		  return $! (res /= (#const SQLITE_DONE))
  
! 		getColValue stmt colNumber fieldDef f = do
! 		  cstr <- sqlite3_column_text stmt (fromIntegral colNumber)
! 		  if cstr == nullPtr
! 		    then f fieldDef cstr 0
! 		    else do strLen <- strlen cstr
! 		            f fieldDef cstr (fromIntegral strLen)
! 
! 		setParam sqlite stmt index (SqlStringValue    value) =
! 		  withCStringLen value $ \(cstr,len) -> do
! 		    res <- sqlite3_bind_text stmt (fromIntegral (index+1)) cstr (fromIntegral len) (#const SQLITE_TRANSIENT)
! 		    handleSqlResult sqlite res
! 		setParam sqlite stmt index (SqlIntValue       value) = do
! 		    res <- sqlite3_bind_int stmt (fromIntegral (index+1)) (fromIntegral value)
! 		    handleSqlResult sqlite res
! 		setParam sqlite stmt index (SqlDoubleValue    value) = do
! 		    res <- sqlite3_bind_double stmt (fromIntegral (index+1)) value
! 		    handleSqlResult sqlite res
! 		setParam sqlite stmt index (SqlBoolValue      value) =
! 		  alloca $ \pchar -> do
! 		    poke pchar (castCharToCChar $! (if value then 't' else 'f'))
! 		    res <- sqlite3_bind_text stmt (fromIntegral (index+1)) pchar 1 (#const SQLITE_TRANSIENT)
! 		    handleSqlResult sqlite res
! 		setParam sqlite stmt index (SqlClockTimeValue value) = throwDyn SqlUnsupportedOperation
! 		setParam sqlite stmt index (SqlNullValue           ) = do
! 		    res <- sqlite3_bind_null stmt (fromIntegral (index+1))
! 		    handleSqlResult sqlite res