direct-sqlite 2.3.2 → 2.3.3

raw patch · 4 files changed

+108/−1 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Database/SQLite3/Bindings.hs +26/−0
• Database/SQLite3/Direct.hs +32/−0
• direct-sqlite.cabal +3/−1
• test/Main.hs +47/−0

@@ -7,6 +7,9 @@     c_sqlite3_close,     c_sqlite3_errmsg,     c_sqlite3_interrupt,+    c_sqlite3_trace,+    CTraceCallback,+    mkCTraceCallback,      -- * Simple query execution     -- | <http://sqlite.org/c3ref/exec.html>@@ -21,6 +24,7 @@     c_sqlite3_reset,     c_sqlite3_finalize,     c_sqlite3_clear_bindings,+    c_sqlite3_sql,      -- * Parameter and column information     c_sqlite3_bind_parameter_count,@@ -77,7 +81,16 @@ foreign import ccall "sqlite3_interrupt"     c_sqlite3_interrupt :: Ptr CDatabase -> IO () +-- | <http://www.sqlite.org/c3ref/profile.html>+foreign import ccall "sqlite3_trace"+    c_sqlite3_trace+        :: Ptr CDatabase+        -> FunPtr (CTraceCallback a) -- ^ Optional callback function called for each row+        -> Ptr a                     -- ^ Context passed to the callback+        -> IO (Ptr ())               -- ^ Returns context pointer from previously+                                     --   registered trace + foreign import ccall "sqlite3_exec"     c_sqlite3_exec         :: Ptr CDatabase@@ -99,6 +112,12 @@                     --   'c_sqlite3_exec' returns @SQLITE_ABORT@                     --   ('ErrorAbort'). +type CTraceCallback a+     = Ptr a+    -> CString      -- ^ UTF-8 rendering of the SQL statement text as+                    -- the statement first begins executing+    -> IO ()+ -- | A couple important things to know about callbacks from Haskell code: -- --  * If the callback throws an exception, apparently, the /whole program/ is@@ -109,7 +128,10 @@ foreign import ccall "wrapper"     mkCExecCallback :: CExecCallback a -> IO (FunPtr (CExecCallback a)) +foreign import ccall "wrapper"+    mkCTraceCallback :: CTraceCallback a -> IO (FunPtr (CTraceCallback a)) + -- | <http://www.sqlite.org/c3ref/prepare.html> -- -- If the query contains no SQL statements, this returns @SQLITE_OK@ and sets@@ -153,6 +175,10 @@ -- A look at the source reveals that this function always returns @SQLITE_OK@. foreign import ccall unsafe "sqlite3_clear_bindings"     c_sqlite3_clear_bindings :: Ptr CStatement -> IO CError++-- | <http://www.sqlite.org/c3ref/sql.html>+foreign import ccall unsafe "sqlite3_sql"+    c_sqlite3_sql :: Ptr CStatement -> IO CString  -- | <http://www.sqlite.org/c3ref/bind_parameter_count.html> --

@@ -12,6 +12,7 @@     open,     close,     errmsg,+    setTrace,      -- * Simple query execution     -- | <http://sqlite.org/c3ref/exec.html>@@ -26,6 +27,7 @@     reset,     finalize,     clearBindings,+    statementSql,      -- * Parameter and column information     bindParameterCount,@@ -284,6 +286,29 @@     -> [Maybe Utf8]   -- ^ List of column values, as returned by 'columnText'.     -> IO () +-- | <http://www.sqlite.org/c3ref/profile.html>+--+-- Enable/disable tracing of SQL execution.  Tracing can be disabled+-- by setting 'Nothing' as the logger callback.+--+-- Warning: If the logger callback throws an exception, your whole+-- program will crash.  Enable only for debugging!+setTrace :: Database -> Maybe (Utf8 -> IO ()) -> IO ()+setTrace (Database db) logger =+    case logger of+        Nothing -> do+            _ <- c_sqlite3_trace db nullFunPtr nullPtr+            return ()+        Just output -> do+            -- NB: this FunPtr never gets freed.  Shouldn't be a big deal,+            -- though, since 'setTrace' is mainly for debugging, and is+            -- typically only called once per application invocation.+            cb <- mkCTraceCallback $ \_ctx cStr -> do+                msg <- packUtf8 (Utf8 BS.empty) id cStr+                output msg+            _ <- c_sqlite3_trace db cb nullPtr+            return ()+ -- | <http://www.sqlite.org/c3ref/prepare.html> -- -- If the query contains no SQL statements, this returns@@ -328,6 +353,13 @@ finalize :: Statement -> IO (Either Error ()) finalize (Statement stmt) =     toResult () <$> c_sqlite3_finalize stmt++-- | <http://www.sqlite.org/c3ref/sql.html>+--+-- Return a copy of the original SQL text used to compile the statement.+statementSql :: Statement -> IO (Maybe Utf8)+statementSql (Statement stmt) =+    c_sqlite3_sql stmt >>= packUtf8 Nothing Just  -- | <http://www.sqlite.org/c3ref/clear_bindings.html> --

@@ -1,5 +1,5 @@ name: direct-sqlite-version: 2.3.2+version: 2.3.3 build-type: Simple license: BSD3 license-file: LICENSE@@ -20,6 +20,8 @@   supports strings encoded as UTF8, and BLOBs represented as ByteStrings.   .   Release history:+  .+  [Version 2.3.3] Add trace support, as a feature for debugging.   .   [Version 2.3.2] Add execPrint, execWithCallback, and interruptibly functions.   Add bindings for sqlite3_last_insert_rowid and sqlite3_changes.  Change the

@@ -19,6 +19,7 @@ import qualified Data.ByteString        as B import qualified Data.ByteString.Char8  as B8 import qualified Data.Text              as T+import qualified Data.Text.Encoding     as T import qualified Data.Text.IO           as T  data TestEnv =@@ -48,6 +49,8 @@     , TestLabel "Integrity"     . testIntegrity     , TestLabel "DecodeError"   . testDecodeError     , TestLabel "ResultStats"   . testResultStats+    , TestLabel "Debug"         . testStatementSql+    , TestLabel "Debug"         . testTracing     ] ++     (if rtsSupportsBoundThreads then     [ TestLabel "Interrupt"     . testInterrupt@@ -149,6 +152,43 @@      return () ++testTracing :: TestEnv -> Test+testTracing TestEnv{..} = TestCase $+  withConn $ \conn -> do+    chan <- newChan+    let logger m = writeChan chan m+    Direct.setTrace conn (Just logger)+    withStmt conn "SELECT null" $ \stmt -> do+      Row <- step stmt+      res <- columns stmt+      Done <- step stmt+      assertEqual "tracing" [SQLNull] res+      Direct.Utf8 msg <- readChan chan+      assertEqual "tracing" "SELECT null" msg+    withStmt conn "SELECT 1+?" $ \stmt -> do+      bind stmt [SQLInteger 2]+      Row <- step stmt+      Done <- step stmt+      reset stmt+      bind stmt [SQLInteger 3]+      Row <- step stmt+      Done <- step stmt+      Direct.Utf8 msg <- readChan chan+      assertEqual "tracing" "SELECT 1+2" msg+      Direct.Utf8 msg <- readChan chan+      assertEqual "tracing" "SELECT 1+3" msg+      -- Check that disabling works too+      Direct.setTrace conn Nothing+      reset stmt+      bind stmt [SQLInteger 3]+      Row <- step stmt+      Done <- step stmt+      writeChan chan (Direct.Utf8 "empty")+      Direct.Utf8 msg <- readChan chan+      assertEqual "tracing" "empty" msg++ -- Simplest SELECT testSimplest :: TestEnv -> Test testSimplest TestEnv{..} = TestCase $ do@@ -531,6 +571,13 @@       liftM3 (,,) (lastInsertRowId conn)                   (changes conn)                   (Direct.totalChanges conn)++testStatementSql :: TestEnv -> Test+testStatementSql TestEnv{..} = TestCase $ do+  let q1 = "SELECT 1+1"+  withStmt conn q1 $ \stmt -> do+    Just (Direct.Utf8 sql1) <- Direct.statementSql stmt+    T.encodeUtf8 q1 @=? sql1  testInterrupt :: TestEnv -> Test testInterrupt TestEnv{..} = TestCase $