diff --git a/Database/HDBC/Sqlite3/Consts.hs b/Database/HDBC/Sqlite3/Consts.hs deleted file mode 100644 --- a/Database/HDBC/Sqlite3/Consts.hs +++ /dev/null @@ -1,188 +0,0 @@ -{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-} -{-# INCLUDE #-} -{-# LINE 1 "Database/HDBC/Sqlite3/Consts.hsc" #-} -{- -*- mode: haskell; -*- -{-# LINE 2 "Database/HDBC/Sqlite3/Consts.hsc" #-} - vim: set filetype=haskell: -Copyright (C) 2005-2007 John Goerzen - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - --} - -module Database.HDBC.Sqlite3.Consts - (sqlite_OK, - sqlite_ERROR, - sqlite_INTERNAL, - sqlite_PERM, - sqlite_ABORT, - sqlite_BUSY, - sqlite_LOCKED, - sqlite_NOMEM, - sqlite_READONLY, - sqlite_INTERRUPT, - sqlite_IOERR, - sqlite_CORRUPT, - sqlite_NOTFOUND, - sqlite_FULL, - sqlite_CANTOPEN, - sqlite_PROTOCOL, - sqlite_EMPTY, - sqlite_SCHEMA, - sqlite_TOOBIG, - sqlite_CONSTRAINT, - sqlite_MISMATCH, - sqlite_MISUSE, - sqlite_NOLFS, - sqlite_AUTH, - sqlite_ROW, - sqlite_DONE) -where - -import Foreign.C.Types - - -{-# LINE 53 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Successful result -sqlite_OK :: Int -sqlite_OK = 0 -{-# LINE 57 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | SQL error or missing database -sqlite_ERROR :: Int -sqlite_ERROR = 1 -{-# LINE 61 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | An internal logic error in SQLite -sqlite_INTERNAL :: Int -sqlite_INTERNAL = 2 -{-# LINE 65 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Access permission denied -sqlite_PERM :: Int -sqlite_PERM = 3 -{-# LINE 69 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Callback routine requested an abort -sqlite_ABORT :: Int -sqlite_ABORT = 4 -{-# LINE 73 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | The database file is locked -sqlite_BUSY :: Int -sqlite_BUSY = 5 -{-# LINE 77 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | A table in the database is locked -sqlite_LOCKED :: Int -sqlite_LOCKED = 6 -{-# LINE 81 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | A malloc() failed -sqlite_NOMEM :: Int -sqlite_NOMEM = 7 -{-# LINE 85 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Attempt to write a readonly database -sqlite_READONLY :: Int -sqlite_READONLY = 8 -{-# LINE 89 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Operation terminated by sqlite_interrupt() -sqlite_INTERRUPT :: Int -sqlite_INTERRUPT = 9 -{-# LINE 93 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Some kind of disk I\/O error occurred -sqlite_IOERR :: Int -sqlite_IOERR = 10 -{-# LINE 97 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | The database disk image is malformed -sqlite_CORRUPT :: Int -sqlite_CORRUPT = 11 -{-# LINE 101 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | (Internal Only) Table or record not found -sqlite_NOTFOUND :: Int -sqlite_NOTFOUND = 12 -{-# LINE 105 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Insertion failed because database is full -sqlite_FULL :: Int -sqlite_FULL = 13 -{-# LINE 109 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Unable to open the database file -sqlite_CANTOPEN :: Int -sqlite_CANTOPEN = 14 -{-# LINE 113 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Database lock protocol error -sqlite_PROTOCOL :: Int -sqlite_PROTOCOL = 15 -{-# LINE 117 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | (Internal Only) Database table is empty -sqlite_EMPTY :: Int -sqlite_EMPTY = 16 -{-# LINE 121 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | The database schema changed -sqlite_SCHEMA :: Int -sqlite_SCHEMA = 17 -{-# LINE 125 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Too much data for one row of a table -sqlite_TOOBIG :: Int -sqlite_TOOBIG = 18 -{-# LINE 129 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Abort due to constraint violation -sqlite_CONSTRAINT :: Int -sqlite_CONSTRAINT = 19 -{-# LINE 133 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Data type mismatch -sqlite_MISMATCH :: Int -sqlite_MISMATCH = 20 -{-# LINE 137 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Library used incorrectly -sqlite_MISUSE :: Int -sqlite_MISUSE = 21 -{-# LINE 141 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Uses OS features not supported on host -sqlite_NOLFS :: Int -sqlite_NOLFS = 22 -{-# LINE 145 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | Authorization denied -sqlite_AUTH :: Int -sqlite_AUTH = 23 -{-# LINE 149 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | sqlite_step() has another row ready -sqlite_ROW :: Int -sqlite_ROW = 100 -{-# LINE 153 "Database/HDBC/Sqlite3/Consts.hsc" #-} - --- | sqlite_step() has finished executing -sqlite_DONE :: Int -sqlite_DONE = 101 -{-# LINE 157 "Database/HDBC/Sqlite3/Consts.hsc" #-} - diff --git a/Database/HDBC/Sqlite3/Statement.hs b/Database/HDBC/Sqlite3/Statement.hs deleted file mode 100644 --- a/Database/HDBC/Sqlite3/Statement.hs +++ /dev/null @@ -1,271 +0,0 @@ -{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-} -{-# INCLUDE #-} -{-# LINE 1 "Database/HDBC/Sqlite3/Statement.hsc" #-} --- -*- mode: haskell; -*- -{-# LINE 2 "Database/HDBC/Sqlite3/Statement.hsc" #-} -{-# CFILES hdbc-sqlite3-helper.c #-} --- Above line for Hugs -{- -Copyright (C) 2005 John Goerzen - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - --} -module Database.HDBC.Sqlite3.Statement where -import Database.HDBC.Types -import Database.HDBC -import Database.HDBC.Sqlite3.Types -import Database.HDBC.Sqlite3.Utils -import Foreign.C.Types -import Foreign.ForeignPtr -import Foreign.Ptr -import Control.Concurrent.MVar -import Foreign.C.String -import Foreign.Marshal -import Foreign.Storable -import Control.Monad -import qualified Data.ByteString as B -import Data.List -import Control.Exception -import Database.HDBC.DriverUtils - - -{-# LINE 41 "Database/HDBC/Sqlite3/Statement.hsc" #-} - -{- One annoying thing about Sqlite is that a disconnect operation will actually -fail if there are any active statements. This is highly annoying, and makes -for some somewhat complex algorithms. -} - -data StoState = Empty -- ^ Not initialized or last execute\/fetchrow had no results - | Prepared Stmt -- ^ Prepared but not executed - | Executed Stmt -- ^ Executed and more rows are expected - -instance Show StoState where - show Empty = "Empty" - show (Prepared _) = "Prepared" - show (Executed _) = "Executed" - -data SState = SState {dbo :: Sqlite3, - stomv :: MVar StoState, - querys :: String, - colnamesmv :: MVar [String]} - -newSth :: Sqlite3 -> ChildList -> String -> IO Statement -newSth indbo mchildren str = - do newstomv <- newMVar Empty - newcolnamesmv <- newMVar [] - let sstate = SState{dbo = indbo, - stomv = newstomv, - querys = str, - colnamesmv = newcolnamesmv} - modifyMVar_ (stomv sstate) (\_ -> (fprepare sstate >>= return . Prepared)) - let retval = - Statement {execute = fexecute sstate, - executeMany = fexecutemany sstate, - finish = public_ffinish sstate, - fetchRow = ffetchrow sstate, - originalQuery = str, - getColumnNames = readMVar (colnamesmv sstate), - describeResult = fail "Sqlite3 backend does not support describeResult"} - addChild mchildren retval - return retval - -{- The deal with adding the \0 below is in response to an apparent bug in -sqlite3. See debian bug #343736. - -This function assumes that any existing query in the state has already -been terminated. (FIXME: should check this at runtime.... never run fprepare -unless state is Empty) --} -fprepare :: SState -> IO Stmt -fprepare sstate = withRawSqlite3 (dbo sstate) - (\p -> withCStringLen ((querys sstate) ++ "\0") - (\(cs, cslen) -> alloca - (\(newp::Ptr (Ptr CStmt)) -> - (do res <- sqlite3_prepare p cs (fromIntegral cslen) newp nullPtr - checkError ("prepare " ++ (show cslen) ++ ": " ++ (querys sstate)) - (dbo sstate) res - newo <- peek newp - newForeignPtr sqlite3_finalizeptr newo - ) - ) - ) - ) - - -{- General algorithm: find out how many columns we have, check the type -of each to see if it's NULL. If it's not, fetch it as text and return that. - -Note that execute() will have already loaded up the first row -- and we -do that each time. so this function returns the row that is already in sqlite, -then loads the next row. -} -ffetchrow :: SState -> IO (Maybe [SqlValue]) -ffetchrow sstate = modifyMVar (stomv sstate) dofetchrow - where dofetchrow Empty = return (Empty, Nothing) - dofetchrow (Prepared _) = - throwDyn $ SqlError {seState = "HDBC Sqlite3 fetchrow", - seNativeError = (-1), - seErrorMsg = "Attempt to fetch row from Statement that has not been executed. Query was: " ++ (querys sstate)} - dofetchrow (Executed sto) = withStmt sto (\p -> - do ccount <- sqlite3_column_count p - -- fetch the data - res <- mapM (getCol p) [0..(ccount - 1)] - r <- fstep (dbo sstate) p - if r - then return (Executed sto, Just res) - else do ffinish (dbo sstate) sto - return (Empty, Just res) - ) - - getCol p icol = - do t <- sqlite3_column_type p icol - if t == 5 -{-# LINE 130 "Database/HDBC/Sqlite3/Statement.hsc" #-} - then return SqlNull - else do text <- sqlite3_column_text p icol - len <- sqlite3_column_bytes p icol - s <- peekCStringLen (text, fromIntegral len) - return (SqlString s) - -fstep :: Sqlite3 -> Ptr CStmt -> IO Bool -fstep dbo p = - do r <- sqlite3_step p - case r of - 100 -> return True -{-# LINE 141 "Database/HDBC/Sqlite3/Statement.hsc" #-} - 101 -> return False -{-# LINE 142 "Database/HDBC/Sqlite3/Statement.hsc" #-} - 1 -> checkError "step" dbo 1 -{-# LINE 143 "Database/HDBC/Sqlite3/Statement.hsc" #-} - >> (throwDyn $ SqlError - {seState = "", - seNativeError = 0, - seErrorMsg = "In HDBC step, internal processing error (got SQLITE_ERROR with no error)"}) - x -> throwDyn $ SqlError {seState = "", - seNativeError = fromIntegral x, - seErrorMsg = "In HDBC step, unexpected result from sqlite3_step"} - -fexecute sstate args = modifyMVar (stomv sstate) doexecute - where doexecute (Executed sto) = ffinish (dbo sstate) sto >> doexecute Empty - doexecute Empty = -- already cleaned up from last time - do sto <- fprepare sstate - doexecute (Prepared sto) - doexecute (Prepared sto) = withStmt sto (\p -> - do c <- sqlite3_bind_parameter_count p - when (c /= genericLength args) - (throwDyn $ SqlError {seState = "", - seNativeError = (-1), - seErrorMsg = "In HDBC execute, received " ++ (show args) ++ " but expected " ++ (show c) ++ " args."}) - sqlite3_reset p >>= checkError "execute (reset)" (dbo sstate) - zipWithM_ (bindArgs p) [1..c] args - - {- Logic for handling counts of changes: look at the total - changes before and after the query. If they differ, - then look at the local changes. (The local change counter - appears to not be updated unless really running a query - that makes a change, according to the docs.) - - This is OK thread-wise because SQLite doesn't support - using a given dbh in more than one thread anyway. -} - origtc <- withSqlite3 (dbo sstate) sqlite3_total_changes - r <- fstep (dbo sstate) p - newtc <- withSqlite3 (dbo sstate) sqlite3_total_changes - changes <- if origtc == newtc - then return 0 - else withSqlite3 (dbo sstate) sqlite3_changes - fgetcolnames p >>= swapMVar (colnamesmv sstate) - if r - then return (Executed sto, fromIntegral changes) - else do ffinish (dbo sstate) sto - return (Empty, fromIntegral changes) - ) - bindArgs p i SqlNull = - sqlite3_bind_null p i >>= - checkError ("execute (binding NULL column " ++ (show i) ++ ")") - (dbo sstate) - bindArgs p i (SqlByteString bs) = - B.useAsCStringLen bs (bindCStringArgs p i) - bindArgs p i arg = withCStringLen (fromSql arg) (bindCStringArgs p i) - - bindCStringArgs p i (cs, len) = - do r <- sqlite3_bind_text2 p i cs (fromIntegral len) - checkError ("execute (binding column " ++ - (show i) ++ ")") (dbo sstate) r - -fgetcolnames csth = - do count <- sqlite3_column_count csth - mapM (getCol csth) [0..(count -1)] - where getCol csth i = - do cstr <- sqlite3_column_name csth i - peekCString cstr - --- FIXME: needs a faster algorithm. -fexecutemany sstate arglist = - mapM_ (fexecute sstate) arglist - ---ffinish o = withForeignPtr o (\p -> sqlite3_finalize p >>= checkError "finish") --- Finish and change state -public_ffinish sstate = modifyMVar_ (stomv sstate) worker - where worker (Empty) = return Empty - worker (Prepared sto) = ffinish (dbo sstate) sto >> return Empty - worker (Executed sto) = ffinish (dbo sstate) sto >> return Empty - -ffinish dbo o = withRawStmt o (\p -> do r <- sqlite3_finalize p - checkError "finish" dbo r) - -foreign import ccall unsafe "hdbc-sqlite3-helper.h &sqlite3_finalize_finalizer" - sqlite3_finalizeptr :: FunPtr ((Ptr CStmt) -> IO ()) - -foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_finalize_app" - sqlite3_finalize :: (Ptr CStmt) -> IO CInt - -foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_prepare2" - sqlite3_prepare :: (Ptr CSqlite3) -> CString -> CInt -> Ptr (Ptr CStmt) -> Ptr (Ptr CString) -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_bind_parameter_count" - sqlite3_bind_parameter_count :: (Ptr CStmt) -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_step" - sqlite3_step :: (Ptr CStmt) -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_reset" - sqlite3_reset :: (Ptr CStmt) -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_column_count" - sqlite3_column_count :: (Ptr CStmt) -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_column_name" - sqlite3_column_name :: Ptr CStmt -> CInt -> IO CString - -foreign import ccall unsafe "sqlite3.h sqlite3_column_type" - sqlite3_column_type :: (Ptr CStmt) -> CInt -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_column_text" - sqlite3_column_text :: (Ptr CStmt) -> CInt -> IO CString - -foreign import ccall unsafe "sqlite3.h sqlite3_column_bytes" - sqlite3_column_bytes :: (Ptr CStmt) -> CInt -> IO CInt - -foreign import ccall unsafe "hdbc-sqlite3-helper.h sqlite3_bind_text2" - sqlite3_bind_text2 :: (Ptr CStmt) -> CInt -> CString -> CInt -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_bind_null" - sqlite3_bind_null :: (Ptr CStmt) -> CInt -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_changes" - sqlite3_changes :: Ptr CSqlite3 -> IO CInt - -foreign import ccall unsafe "sqlite3.h sqlite3_total_changes" - sqlite3_total_changes :: Ptr CSqlite3 -> IO CInt diff --git a/Database/HDBC/Sqlite3/Utils.hs b/Database/HDBC/Sqlite3/Utils.hs deleted file mode 100644 --- a/Database/HDBC/Sqlite3/Utils.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-} -{-# INCLUDE "hdbc-sqlite3-helper.h" #-} -{-# LINE 1 "Database/HDBC/Sqlite3/Utils.hsc" #-} -{- -*- mode: haskell; -*- -{-# LINE 2 "Database/HDBC/Sqlite3/Utils.hsc" #-} - vim: set filetype=haskell: -Copyright (C) 2005-2007 John Goerzen - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - --} - -module Database.HDBC.Sqlite3.Utils where -import Foreign.C.String -import Foreign.ForeignPtr -import Foreign.Ptr -import Database.HDBC.Types -import Database.HDBC.Sqlite3.Types -import Foreign.C.Types -import Control.Exception -import Foreign.Storable - - -{-# LINE 32 "Database/HDBC/Sqlite3/Utils.hsc" #-} - -checkError :: String -> Sqlite3 -> CInt -> IO () -checkError _ _ 0 = return () -checkError msg o res = - withSqlite3 o - (\p -> do rc <- sqlite3_errmsg p - str <- peekCString rc - throwDyn $ SqlError {seState = "", - seNativeError = fromIntegral res, - seErrorMsg = msg ++ ": " ++ str} - ) - -{- This is a little hairy. - -We have a CSqlite3 object that is actually a finalizeonce wrapper around -the real object. We use withSqlite3 to dereference the foreign pointer, -and then extract the pointer to the real object from the finalizeonce struct. - -But, when we close the connection, we need the finalizeonce struct, so that's -done by withRawSqlite3. - -Ditto for statements. -} - -withSqlite3 :: Sqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b -withSqlite3 = genericUnwrap - -withRawSqlite3 :: Sqlite3 -> (Ptr CSqlite3 -> IO b) -> IO b -withRawSqlite3 = withForeignPtr - -withStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b -withStmt = genericUnwrap - -withRawStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b -withRawStmt = withForeignPtr - - -genericUnwrap :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -genericUnwrap fptr action = withForeignPtr fptr (\structptr -> - do objptr <- (\hsc_ptr -> peekByteOff hsc_ptr 0) structptr -{-# LINE 71 "Database/HDBC/Sqlite3/Utils.hsc" #-} - action objptr - ) - -foreign import ccall unsafe "sqlite3.h sqlite3_errmsg" - sqlite3_errmsg :: (Ptr CSqlite3) -> IO CString - diff --git a/HDBC-sqlite3.cabal b/HDBC-sqlite3.cabal --- a/HDBC-sqlite3.cabal +++ b/HDBC-sqlite3.cabal @@ -1,9 +1,9 @@ Name: HDBC-sqlite3 -Version: 1.1.4.0 +Version: 1.1.6.0 License: LGPL Maintainer: John Goerzen Author: John Goerzen -Copyright: Copyright (c) 2005-2007 John Goerzen +Copyright: Copyright (c) 2005-2008 John Goerzen license-file: COPYRIGHT extra-source-files: COPYING, hdbc-sqlite3-helper.h homepage: http://software.complete.org/hdbc-sqlite3 @@ -19,7 +19,7 @@ Library if flag(splitBase) - Build-Depends: base>=3, bytestring + Build-Depends: base>=3 && <4, bytestring else Build-Depends: base<3 Build-Depends: mtl, HDBC>=1.1.0