HDBC-sqlite3 1.1.3.1 → 1.1.4.0
raw patch · 6 files changed
+601/−32 lines, 6 filesdep +bytestringdep ~base
Dependencies added: bytestring
Dependency ranges changed: base
Files
- Database/HDBC/Sqlite3/Connection.hs +3/−3
- Database/HDBC/Sqlite3/Consts.hs +188/−0
- Database/HDBC/Sqlite3/Statement.hs +271/−0
- Database/HDBC/Sqlite3/Statement.hsc +28/−13
- Database/HDBC/Sqlite3/Utils.hs +82/−0
- HDBC-sqlite3.cabal +29/−16
Database/HDBC/Sqlite3/Connection.hs view
@@ -65,7 +65,7 @@ Impl.commit = fcommit obj children, Impl.rollback = frollback obj children, Impl.run = frun obj children,- Impl.prepare = newSth obj children,+ Impl.prepare = newSth obj children True, Impl.clone = connectSqlite3 fp, Impl.hdbcDriverName = "sqlite3", Impl.hdbcClientVer = ver,@@ -78,7 +78,7 @@ Impl.setBusyTimeout = fsetbusy obj} fgettables o mchildren =- do sth <- newSth o mchildren "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name"+ do sth <- newSth o mchildren True "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name" execute sth [] res1 <- fetchAllRows' sth let res = map fromSql $ concat res1@@ -95,7 +95,7 @@ begin_transaction o children = frun o children "BEGIN" [] >> return () frun o mchildren query args =- do sth <- newSth o mchildren query+ do sth <- newSth o mchildren False query res <- execute sth args finish sth return res
+ Database/HDBC/Sqlite3/Consts.hs view
@@ -0,0 +1,188 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# INCLUDE <sqlite3.h> #-}+{-# 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 <jgoerzen@complete.org>++ 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" #-}+
+ Database/HDBC/Sqlite3/Statement.hs view
@@ -0,0 +1,271 @@+{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}+{-# INCLUDE <sqlite3.h> #-}+{-# 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 <jgoerzen@complete.org>++ 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
Database/HDBC/Sqlite3/Statement.hsc view
@@ -46,25 +46,29 @@ 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+ | Exhausted Stmt -- ^ Executed and at end of rows instance Show StoState where show Empty = "Empty" show (Prepared _) = "Prepared" show (Executed _) = "Executed"+ show (Exhausted _) = "Exhausted" data SState = SState {dbo :: Sqlite3, stomv :: MVar StoState, querys :: String,- colnamesmv :: MVar [String]}+ colnamesmv :: MVar [String],+ autoFinish :: Bool} -newSth :: Sqlite3 -> ChildList -> String -> IO Statement-newSth indbo mchildren str = +newSth :: Sqlite3 -> ChildList -> Bool -> String -> IO Statement+newSth indbo mchildren autoFinish str = do newstomv <- newMVar Empty newcolnamesmv <- newMVar [] let sstate = SState{dbo = indbo, stomv = newstomv, querys = str,- colnamesmv = newcolnamesmv}+ colnamesmv = newcolnamesmv,+ autoFinish = autoFinish} modifyMVar_ (stomv sstate) (\_ -> (fprepare sstate >>= return . Prepared)) let retval = Statement {execute = fexecute sstate,@@ -120,9 +124,12 @@ r <- fstep (dbo sstate) p if r then return (Executed sto, Just res)- else do ffinish (dbo sstate) sto- return (Empty, Just res)- )+ else if (autoFinish sstate)+ then do ffinish (dbo sstate) sto+ return (Empty, Just res)+ else return (Exhausted sto, Just res)+ )+ dofetchrow (Exhausted sto) = return (Exhausted sto, Nothing) getCol p icol = do t <- sqlite3_column_type p icol@@ -149,7 +156,8 @@ 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+ where doexecute (Executed sto) = doexecute (Prepared sto)+ doexecute (Exhausted sto) = doexecute (Prepared sto) doexecute Empty = -- already cleaned up from last time do sto <- fprepare sstate doexecute (Prepared sto)@@ -179,8 +187,10 @@ fgetcolnames p >>= swapMVar (colnamesmv sstate) if r then return (Executed sto, fromIntegral changes)- else do ffinish (dbo sstate) sto- return (Empty, fromIntegral changes)+ else if (autoFinish sstate)+ then do ffinish (dbo sstate) sto+ return (Empty, fromIntegral changes)+ else return (Exhausted sto, fromIntegral changes) ) bindArgs p i SqlNull = sqlite3_bind_null p i >>= @@ -202,9 +212,13 @@ do cstr <- sqlite3_column_name csth i peekCString cstr --- FIXME: needs a faster algorithm.-fexecutemany sstate arglist =- mapM_ (fexecute sstate) arglist+fexecutemany _ [] = return ()+fexecutemany sstate (args:[]) = + do fexecute sstate args+ return ()+fexecutemany sstate (args:arglist) =+ do fexecute (sstate { autoFinish = False }) args+ fexecutemany sstate arglist --ffinish o = withForeignPtr o (\p -> sqlite3_finalize p >>= checkError "finish") -- Finish and change state@@ -212,6 +226,7 @@ where worker (Empty) = return Empty worker (Prepared sto) = ffinish (dbo sstate) sto >> return Empty worker (Executed sto) = ffinish (dbo sstate) sto >> return Empty+ worker (Exhausted sto) = ffinish (dbo sstate) sto >> return Empty ffinish dbo o = withRawStmt o (\p -> do r <- sqlite3_finalize p checkError "finish" dbo r)
+ Database/HDBC/Sqlite3/Utils.hs view
@@ -0,0 +1,82 @@+{-# 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 <jgoerzen@complete.org>++ 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+
HDBC-sqlite3.cabal view
@@ -1,6 +1,5 @@-Extra-Libraries: sqlite3 Name: HDBC-sqlite3-Version: 1.1.3.1+Version: 1.1.4.0 License: LGPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -12,17 +11,31 @@ Description: This is the Sqlite v3 driver for HDBC, the generic database access system for Haskell Stability: Stable-Exposed-Modules: Database.HDBC.Sqlite3-Other-Modules: Database.HDBC.Sqlite3.Connection,- Database.HDBC.Sqlite3.ConnectionImpl,- Database.HDBC.Sqlite3.Statement,- Database.HDBC.Sqlite3.Types,- Database.HDBC.Sqlite3.Utils,- Database.HDBC.Sqlite3.Consts---Extensions: ExistentialQuantification, AllowOverlappingInstances,--- AllowUndecidableInstances, CPP-Extensions: ExistentialQuantification-C-Sources: hdbc-sqlite3-helper.c-Build-Depends: base, mtl, HDBC>=1.1.0-include-dirs: .-GHC-Options: -O2+Build-Type: Simple+Cabal-Version: >=1.2++Flag splitBase+ description: Choose the new smaller, split-up package.++Library+ if flag(splitBase)+ Build-Depends: base>=3, bytestring+ else+ Build-Depends: base<3+ Build-Depends: mtl, HDBC>=1.1.0++ C-Sources: hdbc-sqlite3-helper.c+ include-dirs: .+ GHC-Options: -fglasgow-exts+ Extra-Libraries: sqlite3+ Exposed-Modules: Database.HDBC.Sqlite3+ Other-Modules: Database.HDBC.Sqlite3.Connection,+ Database.HDBC.Sqlite3.ConnectionImpl,+ Database.HDBC.Sqlite3.Statement,+ Database.HDBC.Sqlite3.Types,+ Database.HDBC.Sqlite3.Utils,+ Database.HDBC.Sqlite3.Consts+ --Extensions: ExistentialQuantification, AllowOverlappingInstances,+ -- AllowUndecidableInstances, CPP+ Extensions: ExistentialQuantification,+ ForeignFunctionInterface