Skip to content

Added c_sqlite3_update_hook #108

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Added c_sqlite3_update_hook #108

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 14 additions & 0 deletions Database/SQLite3/Bindings.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -523,6 +528,15 @@ type CWalHook = Ptr () -> Ptr CDatabase -> CString -> CInt -> IO CError
foreign import ccall "wrapper"
mkCWalHook :: CWalHook -> IO (FunPtr CWalHook)

-- | <https://www.sqlite.org/c3ref/update_hook.html>
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)

-- | <https://www.sqlite.org/c3ref/blob_open.html>
foreign import ccall unsafe "sqlite3_blob_open"
c_sqlite3_blob_open
Expand Down
125 changes: 125 additions & 0 deletions Database/SQLite3/Bindings/Types.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,12 @@ module Database.SQLite3.Bindings.Types (
encodeColumnType,
ColumnType(..),

-- ** ActionCode
CActionCode(..),
decodeActionCode,
encodeActionCode,
ActionCode(..),

-- * Indices
ParamIndex(..),
ColumnIndex(..),
Expand Down Expand Up @@ -184,6 +190,42 @@ data ColumnType = IntegerColumn
| NullColumn
deriving (Eq, Show)

-- | <https://www.sqlite.org/c3ref/c_alter_table.html>
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

-- | <https://www.sqlite.org/c3ref/sqlite3.html>
--
-- @CDatabase@ = @sqlite3@
Expand Down Expand Up @@ -580,6 +622,85 @@ encodeColumnType t = CColumnType $ case t of
BlobColumn -> #const SQLITE_BLOB
NullColumn -> #const SQLITE_NULL

-- | <https://www.sqlite.org/c3ref/c_alter_table.html>
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

Expand Down Expand Up @@ -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)
17 changes: 17 additions & 0 deletions test/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 ->
Expand Down