diff --git a/Database/SQLite3/Bindings.hs b/Database/SQLite3/Bindings.hs index 9e0a466..c5a7c1e 100644 --- a/Database/SQLite3/Bindings.hs +++ b/Database/SQLite3/Bindings.hs @@ -112,6 +112,11 @@ module Database.SQLite3.Bindings ( CWalHook, mkCWalHook, + -- * Data Change Notification Callbacks + c_sqlite3_update_hook, + CUpdateHook, + mkCUpdateHook, + -- * Incremental blob I/O c_sqlite3_blob_open, c_sqlite3_blob_close, @@ -523,6 +528,15 @@ type CWalHook = Ptr () -> Ptr CDatabase -> CString -> CInt -> IO CError foreign import ccall "wrapper" mkCWalHook :: CWalHook -> IO (FunPtr CWalHook) +-- | +foreign import ccall unsafe "sqlite3_update_hook" + c_sqlite3_update_hook :: Ptr CDatabase -> FunPtr CUpdateHook -> Ptr a -> IO (Ptr ()) + +type CUpdateHook = Ptr () -> CInt -> CString -> CString -> Int64 -> IO () + +foreign import ccall "wrapper" + mkCUpdateHook :: CUpdateHook -> IO (FunPtr CUpdateHook) + -- | foreign import ccall unsafe "sqlite3_blob_open" c_sqlite3_blob_open diff --git a/Database/SQLite3/Bindings/Types.hsc b/Database/SQLite3/Bindings/Types.hsc index d3e6f60..839b79a 100644 --- a/Database/SQLite3/Bindings/Types.hsc +++ b/Database/SQLite3/Bindings/Types.hsc @@ -27,6 +27,12 @@ module Database.SQLite3.Bindings.Types ( encodeColumnType, ColumnType(..), + -- ** ActionCode + CActionCode(..), + decodeActionCode, + encodeActionCode, + ActionCode(..), + -- * Indices ParamIndex(..), ColumnIndex(..), @@ -184,6 +190,42 @@ data ColumnType = IntegerColumn | NullColumn deriving (Eq, Show) +-- | +data ActionCode = CreateIndexAction + | CreateTableAction + | CreateTempIndexAction + | CreateTempTableAction + | CreateTempTriggerAction + | CreateTempViewAction + | CreateTriggerAction + | CreateViewAction + | DeleteAction + | DropIndexAction + | DropTableAction + | DropTempIndexAction + | DropTempTableAction + | DropTempTriggerAction + | DropTempViewAction + | DropTriggerAction + | DropViewAction + | InsertAction + | PragmaAction + | ReadAction + | SelectAction + | TransactionAction + | UpdateAction + | AttachAction + | DetachAction + | AlterTableAction + | ReindexAction + | AnalyzeAction + | CreateVtableAction + | DropVtableAction + | FunctionAction + | SavepointAction + | CopyAction + | RecursiveAction + -- | -- -- @CDatabase@ = @sqlite3@ @@ -580,6 +622,85 @@ encodeColumnType t = CColumnType $ case t of BlobColumn -> #const SQLITE_BLOB NullColumn -> #const SQLITE_NULL +-- | +newtype CActionCode = CActionCode CInt + deriving (Eq, Show) + +decodeActionCode :: CActionCode -> ActionCode +decodeActionCode (CActionCode n) = case n of + #{const SQLITE_CREATE_INDEX} -> CreateIndexAction + #{const SQLITE_CREATE_TABLE} -> CreateTableAction + #{const SQLITE_CREATE_TEMP_INDEX} -> CreateTempIndexAction + #{const SQLITE_CREATE_TEMP_TABLE} -> CreateTempTableAction + #{const SQLITE_CREATE_TEMP_TRIGGER} -> CreateTempTriggerAction + #{const SQLITE_CREATE_TEMP_VIEW} -> CreateTempViewAction + #{const SQLITE_CREATE_TRIGGER} -> CreateTriggerAction + #{const SQLITE_CREATE_VIEW} -> CreateViewAction + #{const SQLITE_DELETE} -> DeleteAction + #{const SQLITE_DROP_INDEX} -> DropIndexAction + #{const SQLITE_DROP_TABLE} -> DropTableAction + #{const SQLITE_DROP_TEMP_INDEX} -> DropTempIndexAction + #{const SQLITE_DROP_TEMP_TABLE} -> DropTempTableAction + #{const SQLITE_DROP_TEMP_TRIGGER} -> DropTempTriggerAction + #{const SQLITE_DROP_TEMP_VIEW} -> DropTempViewAction + #{const SQLITE_DROP_TRIGGER} -> DropTriggerAction + #{const SQLITE_DROP_VIEW} -> DropViewAction + #{const SQLITE_INSERT} -> InsertAction + #{const SQLITE_PRAGMA} -> PragmaAction + #{const SQLITE_READ} -> ReadAction + #{const SQLITE_SELECT} -> SelectAction + #{const SQLITE_TRANSACTION} -> TransactionAction + #{const SQLITE_UPDATE} -> UpdateAction + #{const SQLITE_ATTACH} -> AttachAction + #{const SQLITE_DETACH} -> DetachAction + #{const SQLITE_ALTER_TABLE} -> AlterTableAction + #{const SQLITE_REINDEX} -> ReindexAction + #{const SQLITE_ANALYZE} -> AnalyzeAction + #{const SQLITE_CREATE_VTABLE} -> CreateVtableAction + #{const SQLITE_DROP_VTABLE} -> DropVtableAction + #{const SQLITE_FUNCTION} -> FunctionAction + #{const SQLITE_SAVEPOINT} -> SavepointAction + #{const SQLITE_COPY} -> CopyAction + #{const SQLITE_RECURSIVE} -> RecursiveAction + _ -> error $ "decodeActionCode " ++ show n + +encodeActionCode :: ActionCode -> CActionCode +encodeActionCode t = CActionCode $ case t of + CreateIndexAction -> #const SQLITE_CREATE_INDEX + CreateTableAction -> #const SQLITE_CREATE_TABLE + CreateTempIndexAction -> #const SQLITE_CREATE_TEMP_INDEX + CreateTempTableAction -> #const SQLITE_CREATE_TEMP_TABLE + CreateTempTriggerAction -> #const SQLITE_CREATE_TEMP_TRIGGER + CreateTempViewAction -> #const SQLITE_CREATE_TEMP_VIEW + CreateTriggerAction -> #const SQLITE_CREATE_TRIGGER + CreateViewAction -> #const SQLITE_CREATE_VIEW + DeleteAction -> #const SQLITE_DELETE + DropIndexAction -> #const SQLITE_DROP_INDEX + DropTableAction -> #const SQLITE_DROP_TABLE + DropTempIndexAction -> #const SQLITE_DROP_TEMP_INDEX + DropTempTableAction -> #const SQLITE_DROP_TEMP_TABLE + DropTempTriggerAction -> #const SQLITE_DROP_TEMP_TRIGGER + DropTempViewAction -> #const SQLITE_DROP_TEMP_VIEW + DropTriggerAction -> #const SQLITE_DROP_TRIGGER + DropViewAction -> #const SQLITE_DROP_VIEW + InsertAction -> #const SQLITE_INSERT + PragmaAction -> #const SQLITE_PRAGMA + ReadAction -> #const SQLITE_READ + SelectAction -> #const SQLITE_SELECT + TransactionAction -> #const SQLITE_TRANSACTION + UpdateAction -> #const SQLITE_UPDATE + AttachAction -> #const SQLITE_ATTACH + DetachAction -> #const SQLITE_DETACH + AlterTableAction -> #const SQLITE_ALTER_TABLE + ReindexAction -> #const SQLITE_REINDEX + AnalyzeAction -> #const SQLITE_ANALYZE + CreateVtableAction -> #const SQLITE_CREATE_VTABLE + DropVtableAction -> #const SQLITE_DROP_VTABLE + FunctionAction -> #const SQLITE_FUNCTION + SavepointAction -> #const SQLITE_SAVEPOINT + CopyAction -> #const SQLITE_COPY + RecursiveAction -> #const SQLITE_RECURSIVE + ------------------------------------------------------------------------ -- Conversion to and from FFI types @@ -607,6 +728,10 @@ instance FFIType ColumnType CColumnType where toFFI = encodeColumnType fromFFI = decodeColumnType +instance FFIType ActionCode CActionCode where + toFFI = encodeActionCode + fromFFI = decodeActionCode + instance FFIType ArgCount CArgCount where toFFI (ArgCount n) = CArgCount (fromIntegral n) fromFFI (CArgCount n) = ArgCount (fromIntegral n) diff --git a/test/Main.hs b/test/Main.hs index ace7ca0..0af33ef 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,6 +1,7 @@ import StrictEq import Database.SQLite3 +import qualified Database.SQLite3.Bindings as Bindings import qualified Database.SQLite3.Direct as Direct import Control.Applicative @@ -10,6 +11,7 @@ import Control.Monad (forM_, liftM3, unless) import Data.Functor.Identity import Data.Text.Encoding.Error (UnicodeException(..)) import Data.Typeable +import Foreign.Ptr import System.Directory () import System.Exit (exitFailure) import System.IO @@ -77,6 +79,7 @@ regressionTests2 = regressionTests1 <> [TestLabel "ReadOnly" . testReadOnly] featureTests :: forall f. [TestEnv f -> Test] featureTests = [ TestLabel "MultiRowInsert" . testMultiRowInsert + , TestLabel "UpdateHook" . testUpdateHook ] assertFail :: IO a -> Assertion @@ -917,6 +920,20 @@ testMultiRowInsert TestEnv{..} = TestCase $ do Done <- step stmt return () +testUpdateHook :: forall f. TestEnv f -> Test +testUpdateHook TestEnv{..} = TestCase $ do + m <- newMVar (1 :: Int) + withConn $ \conn@(Direct.Database db) -> do + exec conn "CREATE TABLE foo (a Int)" + h <- Bindings.mkCUpdateHook (\_ _ _ _ _ -> modifyMVar_ m (pure . succ)) + Bindings.c_sqlite3_update_hook db h nullPtr + exec conn "INSERT INTO foo VALUES (1)" + r <- readMVar m + case r of + 2 -> pure () + _ -> assertFailure "Update hook did not fire" + + withTestEnv1 :: String -> (forall f. TestEnv f -> IO a) -> IO a withTestEnv1 tempDbName cb = withConn $ \conn ->