direct-sqlite 2.3.13 → 2.3.14

raw patch · 9 files changed

+811/−23 lines, 9 filesdep ~basedep ~bytestringdep ~textnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, text

API changes (from Hackage documentation)

Files

• Database/SQLite3.hs +127/−2
• Database/SQLite3/Bindings.hs +149/−0
• Database/SQLite3/Bindings/Types.hsc +57/−0
• Database/SQLite3/Direct.hs +276/−1
• cbits/sqlite3.c too large to diff
• cbits/sqlite3.h +105/−13
• changelog +13/−2
• direct-sqlite.cabal +5/−5
• test/Main.hs +79/−0

@@ -58,6 +58,29 @@     lastInsertRowId,     changes, +    -- * Create custom SQL functions+    createFunction,+    createAggregate,+    deleteFunction,+    -- ** Extract function arguments+    funcArgCount,+    funcArgType,+    funcArgInt64,+    funcArgDouble,+    funcArgText,+    funcArgBlob,+    -- ** Set the result of a function+    funcResultSQLData,+    funcResultInt64,+    funcResultDouble,+    funcResultText,+    funcResultBlob,+    funcResultNull,++    -- * Create custom collations+    createCollation,+    deleteCollation,+     -- * Interrupting a long-running query     interrupt,     interruptibly,@@ -68,6 +91,8 @@     SQLData(..),     SQLError(..),     ColumnType(..),+    FuncContext,+    FuncArgs,      -- ** Results and errors     StepResult(..),@@ -77,6 +102,8 @@     ParamIndex(..),     ColumnIndex(..),     ColumnCount,+    ArgCount(..),+    ArgIndex, ) where  import Database.SQLite3.Direct@@ -89,6 +116,10 @@     , ColumnIndex(..)     , ColumnCount     , Utf8(..)+    , FuncContext+    , FuncArgs+    , ArgCount(..)+    , ArgIndex      -- Re-exported from Database.SQLite3.Direct without modification.     -- Note that if this module were in another package, source links would not@@ -100,6 +131,15 @@     , columnBlob     , columnInt64     , columnDouble+    , funcArgCount+    , funcArgType+    , funcArgInt64+    , funcArgDouble+    , funcArgBlob+    , funcResultInt64+    , funcResultDouble+    , funcResultBlob+    , funcResultNull     , lastInsertRowId     , changes     , interrupt@@ -488,8 +528,11 @@ -- if an unknown name is used. -- -- Example:--- >> stmt <- prepare conn "SELECT :foo + :bar"--- >> bindNamed stmt [(":foo", SQLInteger 1), (":bar", SQLInteger 2)]+--+-- @+-- stmt <- prepare conn \"SELECT :foo + :bar\"+-- bindNamed stmt [(\":foo\", SQLInteger 1), (\":bar\", SQLInteger 2)]+-- @ bindNamed :: Statement -> [(T.Text, SQLData)] -> IO () bindNamed statement params = do     ParamIndex nParams <- bindParameterCount statement@@ -544,3 +587,85 @@     f idx theType = case theType of         Nothing -> column statement idx         Just t  -> typedColumn t statement idx+++-- | <http://sqlite.org/c3ref/create_function.html>+--+-- Create a custom SQL function or redefine the behavior of an existing+-- function. If the function is deterministic, i.e. if it always returns the+-- same result given the same input, you can set the boolean flag to let+-- @sqlite@ perform additional optimizations.+createFunction+    :: Database+    -> Text           -- ^ Name of the function.+    -> Maybe ArgCount -- ^ Number of arguments. 'Nothing' means that the+                      --   function accepts any number of arguments.+    -> Bool           -- ^ Is the function deterministic?+    -> (FuncContext -> FuncArgs -> IO ())+                      -- ^ Implementation of the function.+    -> IO ()+createFunction db name nArgs isDet fun =+    Direct.createFunction db (toUtf8 name) nArgs isDet fun+        >>= checkError (DetailDatabase db) ("createFunction " `appendShow` name)++-- | Like 'createFunction' except that it creates an aggregate function.+createAggregate+    :: Database+    -> Text           -- ^ Name of the function.+    -> Maybe ArgCount -- ^ Number of arguments.+    -> a              -- ^ Initial aggregate state.+    -> (FuncContext -> FuncArgs -> a -> IO a)+                      -- ^ Process one row and update the aggregate state.+    -> (FuncContext -> a -> IO ())+                      -- ^ Called after all rows have been processed.+                      --   Can be used to construct the returned value+                      --   from the aggregate state.+    -> IO ()+createAggregate db name nArgs initSt xStep xFinal =+    Direct.createAggregate db (toUtf8 name) nArgs initSt xStep xFinal+        >>= checkError (DetailDatabase db) ("createAggregate " `appendShow` name)++-- | Delete an SQL function (scalar or aggregate).+deleteFunction :: Database -> Text -> Maybe ArgCount -> IO ()+deleteFunction db name nArgs =+    Direct.deleteFunction db (toUtf8 name) nArgs+        >>= checkError (DetailDatabase db) ("deleteFunction " `appendShow` name)++funcArgText :: FuncArgs -> ArgIndex -> IO Text+funcArgText args argIndex =+    Direct.funcArgText args argIndex+        >>= fromUtf8 "Database.SQLite3.funcArgText: Invalid UTF-8"++funcResultSQLData :: FuncContext -> SQLData -> IO ()+funcResultSQLData ctx datum =+    case datum of+        SQLInteger v -> funcResultInt64  ctx v+        SQLFloat   v -> funcResultDouble ctx v+        SQLText    v -> funcResultText   ctx v+        SQLBlob    v -> funcResultBlob   ctx v+        SQLNull      -> funcResultNull   ctx++funcResultText :: FuncContext -> Text -> IO ()+funcResultText ctx value =+    Direct.funcResultText ctx (toUtf8 value)+++-- | <http://www.sqlite.org/c3ref/create_collation.html>+createCollation+    :: Database+    -> Text                       -- ^ Name of the collation.+    -> (Text -> Text -> Ordering) -- ^ Comparison function.+    -> IO ()+createCollation db name cmp =+    Direct.createCollation db (toUtf8 name) cmp'+        >>= checkError (DetailDatabase db) ("createCollation " `appendShow` name)+  where+    cmp' (Utf8 s1) (Utf8 s2) = cmp (fromUtf8'' s1) (fromUtf8'' s2)+    -- avoid throwing exceptions as much as possible+    fromUtf8'' = decodeUtf8With lenientDecode++-- | Delete a collation.+deleteCollation :: Database -> Text -> IO ()+deleteCollation db name =+    Direct.deleteCollation db (toUtf8 name)+        >>= checkError (DetailDatabase db) ("deleteCollation " `appendShow` name)

@@ -56,8 +56,48 @@     c_sqlite3_changes,     c_sqlite3_total_changes, +    -- * Create Or Redefine SQL Functions+    c_sqlite3_create_function_v2,+    CFunc,+    CFuncFinal,+    CFuncDestroy,+    mkCFunc,+    mkCFuncFinal,+    mkCFuncDestroy,+    c_sqlite3_user_data,+    c_sqlite3_context_db_handle,+    c_sqlite3_aggregate_context,++    -- * Obtaining SQL Function Parameter Values+    -- | <http://www.sqlite.org/c3ref/value_blob.html>+    c_sqlite3_value_type,+    c_sqlite3_value_bytes,+    c_sqlite3_value_blob,+    c_sqlite3_value_text,+    c_sqlite3_value_int64,+    c_sqlite3_value_double,++    -- * Setting The Result Of An SQL Function+    -- | <http://www.sqlite.org/c3ref/result_blob.html>+    c_sqlite3_result_null,+    c_sqlite3_result_blob,+    c_sqlite3_result_zeroblob,+    c_sqlite3_result_text,+    c_sqlite3_result_int64,+    c_sqlite3_result_double,+    c_sqlite3_result_value,+    c_sqlite3_result_error,++    -- * Define New Collating Sequences+    c_sqlite3_create_collation_v2,+    CCompare,+    mkCCompare,+     -- * Miscellaneous     c_sqlite3_free,++    -- * Extensions+    c_sqlite3_enable_load_extension ) where  import Database.SQLite3.Bindings.Types@@ -276,7 +316,116 @@ foreign import ccall unsafe "sqlite3_total_changes"     c_sqlite3_total_changes :: Ptr CDatabase -> IO CInt +-- do not use unsafe import here, it might call back to haskell+-- via the CFuncDestroy argument+-- | <http://sqlite.org/c3ref/create_function.html>+foreign import ccall "sqlite3_create_function_v2"+    c_sqlite3_create_function_v2+        :: Ptr CDatabase+        -> CString         -- ^ Name of the function+        -> CArgCount       -- ^ Number of arguments+        -> CInt            -- ^ Preferred text encoding (also used to pass flags)+        -> Ptr a           -- ^ User data+        -> FunPtr CFunc+        -> FunPtr CFunc+        -> FunPtr CFuncFinal+        -> FunPtr (CFuncDestroy a)+        -> IO CError +type CFunc          = Ptr CContext -> CArgCount -> Ptr (Ptr CValue) -> IO ()++type CFuncFinal     = Ptr CContext -> IO ()++type CFuncDestroy a = Ptr a -> IO ()++foreign import ccall "wrapper"+    mkCFunc        :: CFunc          -> IO (FunPtr CFunc)++foreign import ccall "wrapper"+    mkCFuncFinal   :: CFuncFinal     -> IO (FunPtr CFuncFinal)++foreign import ccall "wrapper"+    mkCFuncDestroy :: CFuncDestroy a -> IO (FunPtr (CFuncDestroy a))++-- | <http://www.sqlite.org/c3ref/user_data.html>+foreign import ccall unsafe "sqlite3_user_data"+    c_sqlite3_user_data :: Ptr CContext -> IO (Ptr a)++-- | <http://www.sqlite.org/c3ref/context_db_handle.html>+foreign import ccall unsafe "sqlite3_context_db_handle"+    c_sqlite3_context_db_handle :: Ptr CContext -> IO (Ptr CDatabase)++-- | <http://www.sqlite.org/c3ref/aggregate_context.html>+foreign import ccall unsafe "sqlite3_aggregate_context"+    c_sqlite3_aggregate_context :: Ptr CContext -> CNumBytes -> IO (Ptr a)+++foreign import ccall unsafe "sqlite3_value_type"+    c_sqlite3_value_type   :: Ptr CValue -> IO CColumnType++foreign import ccall unsafe "sqlite3_value_bytes"+    c_sqlite3_value_bytes  :: Ptr CValue -> IO CNumBytes++foreign import ccall unsafe "sqlite3_value_blob"+    c_sqlite3_value_blob   :: Ptr CValue -> IO (Ptr a)++foreign import ccall unsafe "sqlite3_value_text"+    c_sqlite3_value_text   :: Ptr CValue -> IO CString++foreign import ccall unsafe "sqlite3_value_int64"+    c_sqlite3_value_int64  :: Ptr CValue -> IO Int64++foreign import ccall unsafe "sqlite3_value_double"+    c_sqlite3_value_double :: Ptr CValue -> IO Double+++foreign import ccall unsafe "sqlite3_result_null"+    c_sqlite3_result_null     :: Ptr CContext -> IO ()++foreign import ccall unsafe "sqlite3_result_blob"+    c_sqlite3_result_blob     :: Ptr CContext -> Ptr a -> CNumBytes -> Ptr CDestructor -> IO ()++foreign import ccall unsafe "sqlite3_result_zeroblob"+    c_sqlite3_result_zeroblob :: Ptr CContext -> CNumBytes -> IO ()++foreign import ccall unsafe "sqlite3_result_text"+    c_sqlite3_result_text     :: Ptr CContext -> CString -> CNumBytes -> Ptr CDestructor -> IO ()++foreign import ccall unsafe "sqlite3_result_int64"+    c_sqlite3_result_int64    :: Ptr CContext -> Int64 -> IO ()++foreign import ccall unsafe "sqlite3_result_double"+    c_sqlite3_result_double   :: Ptr CContext -> Double -> IO ()++foreign import ccall unsafe "sqlite3_result_value"+    c_sqlite3_result_value    :: Ptr CContext -> Ptr CValue -> IO ()++foreign import ccall unsafe "sqlite3_result_error"+    c_sqlite3_result_error    :: Ptr CContext -> CString -> CNumBytes -> IO ()+++-- | <http://www.sqlite.org/c3ref/create_collation.html>+foreign import ccall "sqlite3_create_collation_v2"+    c_sqlite3_create_collation_v2+        :: Ptr CDatabase+        -> CString         -- ^ Name of the collation+        -> CInt            -- ^ Text encoding+        -> Ptr a           -- ^ User data+        -> FunPtr (CCompare a)+        -> FunPtr (CFuncDestroy a)+        -> IO CError++type CCompare a = Ptr a -> CNumBytes -> CString -> CNumBytes -> CString -> IO CInt++foreign import ccall "wrapper"+    mkCCompare :: CCompare a -> IO (FunPtr (CCompare a))++ -- | <http://sqlite.org/c3ref/free.html> foreign import ccall "sqlite3_free"     c_sqlite3_free :: Ptr a -> IO ()+++-- | <http://sqlite.org/c3ref/enable_load_extension.html>+foreign import ccall "sqlite3_enable_load_extension"+    c_sqlite3_enable_load_extension :: Ptr CDatabase -> Bool -> IO CError

@@ -7,6 +7,8 @@     -- | <http://www.sqlite.org/c3ref/objlist.html>     CDatabase,     CStatement,+    CValue,+    CContext,      -- * Enumerations @@ -36,7 +38,14 @@     CNumBytes(..),     CDestructor,     c_SQLITE_TRANSIENT,+    c_SQLITE_UTF8, +    -- * Custom functions+    ArgCount(..),+    ArgIndex,+    CArgCount(..),+    c_SQLITE_DETERMINISTIC,+     -- * Conversion to and from FFI types     FFIType(..), ) where@@ -100,6 +109,16 @@ -- @CStatement@ = @sqlite3_stmt@ data CStatement +-- | <http://www.sqlite.org/c3ref/value.html>+--+-- @CValue@ = @sqlite3_value@+data CValue++-- | <http://www.sqlite.org/c3ref/context.html>+--+-- @CContext@ = @sqlite3_context@+data CContext+ -- | Index of a parameter in a parameterized query. -- Parameter indices start from 1. --@@ -173,7 +192,41 @@ c_SQLITE_TRANSIENT :: Ptr CDestructor c_SQLITE_TRANSIENT = intPtrToPtr (-1) +c_SQLITE_UTF8 :: CInt+c_SQLITE_UTF8 = #{const SQLITE_UTF8} ++-- | Number of arguments of a user defined SQL function.+newtype ArgCount = ArgCount Int+    deriving (Eq, Ord, Enum, Num, Real, Integral)++-- | This just shows the underlying integer, without the data constructor.+instance Show ArgCount where+    show (ArgCount n) = show n++instance Bounded ArgCount where+    minBound = ArgCount 0+    maxBound = ArgCount (#{const SQLITE_LIMIT_FUNCTION_ARG})++-- | Index of an argument to a custom function. Indices start from 0.+type ArgIndex = ArgCount++newtype CArgCount = CArgCount CInt+    deriving (Eq, Ord, Enum, Num, Real, Integral)++-- | This just shows the underlying integer, without the data constructor.+instance Show CArgCount where+    show (CArgCount n) = show n++instance Bounded CArgCount where+    minBound = CArgCount (-1)+    maxBound = CArgCount #{const SQLITE_LIMIT_FUNCTION_ARG}++-- | Tells SQLite3 that the defined custom SQL function is deterministic.+c_SQLITE_DETERMINISTIC :: CInt+c_SQLITE_DETERMINISTIC = #{const SQLITE_DETERMINISTIC}++ -- | <http://www.sqlite.org/c3ref/c_abort.html> newtype CError = CError CInt     deriving (Eq, Show)@@ -303,3 +356,7 @@ instance FFIType ColumnType CColumnType where     toFFI = encodeColumnType     fromFFI = decodeColumnType++instance FFIType ArgCount CArgCount where+    toFFI (ArgCount n)  = CArgCount (fromIntegral n)+    fromFFI (CArgCount n) = ArgCount (fromIntegral n)

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | -- This API is a slightly lower-level version of "Database.SQLite3".  Namely: --@@ -53,11 +54,36 @@     columnText,     columnBlob, +    -- * control loading of extensions+    setLoadExtensionEnabled,+     -- * Result statistics     lastInsertRowId,     changes,     totalChanges, +    -- * Create custom SQL functions+    createFunction,+    createAggregate,+    deleteFunction,+    -- ** Extract function arguments+    funcArgCount,+    funcArgType,+    funcArgInt64,+    funcArgDouble,+    funcArgText,+    funcArgBlob,+    -- ** Set the result of a function+    funcResultInt64,+    funcResultDouble,+    funcResultText,+    funcResultBlob,+    funcResultNull,++    -- * Create custom collations+    createCollation,+    deleteCollation,+     -- * Interrupting a long-running query     interrupt, @@ -65,6 +91,8 @@     Database(..),     Statement(..),     ColumnType(..),+    FuncContext(..),+    FuncArgs(..),      -- ** Results and errors     StepResult(..),@@ -75,6 +103,8 @@     ParamIndex(..),     ColumnIndex(..),     ColumnCount,+    ArgCount(..),+    ArgIndex, ) where  import Database.SQLite3.Bindings@@ -85,7 +115,7 @@ import qualified Data.Text.Encoding as T import Control.Applicative  ((<$>)) import Control.Exception as E-import Control.Monad        (join)+import Control.Monad        (join, unless) import Data.ByteString      (ByteString) import Data.IORef import Data.Monoid@@ -93,6 +123,7 @@ import Data.Text.Encoding.Error (lenientDecode) import Foreign import Foreign.C+import qualified System.IO.Unsafe as IOU  newtype Database = Database (Ptr CDatabase)     deriving (Eq, Show)@@ -167,6 +198,13 @@         ErrorDone -> Right Done         err       -> Left err +-- | The context in which a custom SQL function is executed.+newtype FuncContext = FuncContext (Ptr CContext)+    deriving (Eq, Show)++-- | The arguments of a custom SQL function.+data FuncArgs = FuncArgs CArgCount (Ptr (Ptr CValue))+ ------------------------------------------------------------------------  -- | <http://www.sqlite.org/c3ref/open.html>@@ -494,3 +532,240 @@ totalChanges :: Database -> IO Int totalChanges (Database db) =     fromIntegral <$> c_sqlite3_total_changes db++-- We use CFuncPtrs to store the function pointers used in the implementation+-- of custom SQL functions so that sqlite can deallocate those pointers when+-- the function is deleted or overwritten+data CFuncPtrs = CFuncPtrs (FunPtr CFunc) (FunPtr CFunc) (FunPtr CFuncFinal)++-- Deallocate the function pointers used to implement a custom function+-- This is only called by sqlite so we create one global FunPtr to pass to+-- sqlite+destroyCFuncPtrs :: FunPtr (CFuncDestroy ())+destroyCFuncPtrs = IOU.unsafePerformIO $ mkCFuncDestroy destroy+  where+    destroy p = do+        let p' = castPtrToStablePtr p+        CFuncPtrs p1 p2 p3 <- deRefStablePtr p'+        unless (p1 == nullFunPtr) $ freeHaskellFunPtr p1+        unless (p2 == nullFunPtr) $ freeHaskellFunPtr p2+        unless (p3 == nullFunPtr) $ freeHaskellFunPtr p3+        freeStablePtr p'+{-# NOINLINE destroyCFuncPtrs #-}++-- | <http://sqlite.org/c3ref/create_function.html>+--+-- Create a custom SQL function or redefine the behavior of an existing+-- function.+createFunction+    :: Database+    -> Utf8           -- ^ Name of the function.+    -> Maybe ArgCount -- ^ Number of arguments. 'Nothing' means that the+                      --   function accepts any number of arguments.+    -> Bool           -- ^ Is the function deterministic?+    -> (FuncContext -> FuncArgs -> IO ())+                      -- ^ Implementation of the function.+    -> IO (Either Error ())+createFunction (Database db) (Utf8 name) nArgs isDet fun = mask_ $ do+    funPtr <- mkCFunc fun'+    u <- newStablePtr $ CFuncPtrs funPtr nullFunPtr nullFunPtr+    BS.useAsCString name $ \namePtr ->+        toResult () <$>+            c_sqlite3_create_function_v2+                db namePtr (maybeArgCount nArgs) flags (castStablePtrToPtr u)+                funPtr nullFunPtr nullFunPtr destroyCFuncPtrs+  where+    flags = if isDet then c_SQLITE_DETERMINISTIC else 0+    fun' ctx nArgs' cvals =+        catchAsResultError ctx $+            fun (FuncContext ctx) (FuncArgs nArgs' cvals)++-- | Like 'createFunction' except that it creates an aggregate function.+createAggregate+    :: Database+    -> Utf8           -- ^ Name of the function.+    -> Maybe ArgCount -- ^ Number of arguments.+    -> a              -- ^ Initial aggregate state.+    -> (FuncContext -> FuncArgs -> a -> IO a)+                      -- ^ Process one row and update the aggregate state.+    -> (FuncContext -> a -> IO ())+                      -- ^ Called after all rows have been processed.+                      --   Can be used to construct the returned value+                      --   from the aggregate state.+    -> IO (Either Error ())+createAggregate (Database db) (Utf8 name) nArgs initSt xStep xFinal = mask_ $ do+    stepPtr <- mkCFunc xStep'+    finalPtr <- mkCFuncFinal xFinal'+    u <- newStablePtr $ CFuncPtrs nullFunPtr stepPtr finalPtr+    BS.useAsCString name $ \namePtr ->+        toResult () <$>+            c_sqlite3_create_function_v2+                db namePtr (maybeArgCount nArgs) 0 (castStablePtrToPtr u)+                nullFunPtr stepPtr finalPtr destroyCFuncPtrs+  where+    -- we store the aggregate state in the buffer returned by+    -- c_sqlite3_aggregate_context as a StablePtr pointing to an IORef that+    -- contains the actual aggregate state+    xStep' ctx nArgs' cvals =+        catchAsResultError ctx $ do+            aggCtx <- getAggregateContext ctx+            aggStPtr <- peek aggCtx+            aggStRef <-+                if castStablePtrToPtr aggStPtr /= nullPtr then+                    deRefStablePtr aggStPtr+                else do+                    aggStRef <- newIORef initSt+                    aggStPtr' <- newStablePtr aggStRef+                    poke aggCtx aggStPtr'+                    return aggStRef+            aggSt <- readIORef aggStRef+            aggSt' <- xStep (FuncContext ctx) (FuncArgs nArgs' cvals) aggSt+            writeIORef aggStRef aggSt'+    xFinal' ctx = do+        aggCtx <- getAggregateContext ctx+        aggStPtr <- peek aggCtx+        if castStablePtrToPtr aggStPtr == nullPtr then+            catchAsResultError ctx $+                xFinal (FuncContext ctx) initSt+        else do+            catchAsResultError ctx $ do+                aggStRef <- deRefStablePtr aggStPtr+                aggSt <- readIORef aggStRef+                xFinal (FuncContext ctx) aggSt+            freeStablePtr aggStPtr+    getAggregateContext ctx =+        c_sqlite3_aggregate_context ctx stPtrSize+    stPtrSize = fromIntegral $ sizeOf (undefined :: StablePtr ())++-- call c_sqlite3_result_error in the event of an error+catchAsResultError :: Ptr CContext -> IO () -> IO ()+catchAsResultError ctx action = catch action $ \exn -> do+    let msg = show (exn :: SomeException)+    withCAStringLen msg $ \(ptr, len) ->+        c_sqlite3_result_error ctx ptr (fromIntegral len)++-- | Delete an SQL function (scalar or aggregate).+deleteFunction :: Database -> Utf8 -> Maybe ArgCount -> IO (Either Error ())+deleteFunction (Database db) (Utf8 name) nArgs =+    BS.useAsCString name $ \namePtr ->+        toResult () <$>+            c_sqlite3_create_function_v2+                db namePtr (maybeArgCount nArgs) 0 nullPtr+                nullFunPtr nullFunPtr nullFunPtr nullFunPtr++maybeArgCount :: Maybe ArgCount -> CArgCount+maybeArgCount (Just n) = toFFI n+maybeArgCount Nothing = -1+++funcArgCount :: FuncArgs -> ArgCount+funcArgCount (FuncArgs nArgs _) = fromIntegral nArgs++funcArgType :: FuncArgs -> ArgIndex -> IO ColumnType+funcArgType =+    extractFuncArg NullColumn (fmap decodeColumnType . c_sqlite3_value_type)++funcArgInt64 :: FuncArgs -> ArgIndex -> IO Int64+funcArgInt64 = extractFuncArg 0 c_sqlite3_value_int64++funcArgDouble :: FuncArgs -> ArgIndex -> IO Double+funcArgDouble = extractFuncArg 0 c_sqlite3_value_double++funcArgText :: FuncArgs -> ArgIndex -> IO Utf8+funcArgText = extractFuncArg mempty $ \cval -> do+    ptr <- c_sqlite3_value_text cval+    len <- c_sqlite3_value_bytes cval+    Utf8 <$> packCStringLen ptr len++funcArgBlob :: FuncArgs -> ArgIndex -> IO ByteString+funcArgBlob  = extractFuncArg mempty $ \cval -> do+    ptr <- c_sqlite3_value_blob cval+    len <- c_sqlite3_value_bytes cval+    packCStringLen ptr len++-- the c_sqlite3_value_* family of functions don't handle null pointers, so+-- we must use a wrapper to guarantee that a sensible value is returned if+-- we are out of bounds+extractFuncArg :: a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgIndex -> IO a+extractFuncArg defVal extract (FuncArgs nArgs p) idx+    | 0 <= idx && idx < fromIntegral nArgs = do+        cval <- peekElemOff p (fromIntegral idx)+        extract cval+    | otherwise = return defVal+++funcResultInt64 :: FuncContext -> Int64 -> IO ()+funcResultInt64 (FuncContext ctx) value =+    c_sqlite3_result_int64 ctx value++funcResultDouble :: FuncContext -> Double -> IO ()+funcResultDouble (FuncContext ctx) value =+    c_sqlite3_result_double ctx value++funcResultText :: FuncContext -> Utf8 -> IO ()+funcResultText (FuncContext ctx) (Utf8 value) =+    unsafeUseAsCStringLenNoNull value $ \ptr len ->+        c_sqlite3_result_text ctx ptr len c_SQLITE_TRANSIENT++funcResultBlob :: FuncContext -> ByteString -> IO ()+funcResultBlob (FuncContext ctx) value =+    unsafeUseAsCStringLenNoNull value $ \ptr len ->+        c_sqlite3_result_blob ctx ptr len c_SQLITE_TRANSIENT++funcResultNull :: FuncContext -> IO ()+funcResultNull (FuncContext ctx) =+    c_sqlite3_result_null ctx+++-- Deallocate the function pointer to the comparison function used to+-- implement a custom collation+destroyCCompare :: CFuncDestroy ()+destroyCCompare ptr = freeHaskellFunPtr ptr'+  where+    ptr' = castPtrToFunPtr ptr :: FunPtr (CCompare ())++-- This is called by sqlite so we create one global FunPtr to pass to sqlite+destroyCComparePtr :: FunPtr (CFuncDestroy ())+destroyCComparePtr = IOU.unsafePerformIO $ mkCFuncDestroy destroyCCompare+{-# NOINLINE destroyCComparePtr #-}++-- | <http://www.sqlite.org/c3ref/create_collation.html>+createCollation+    :: Database+    -> Utf8                       -- ^ Name of the collation.+    -> (Utf8 -> Utf8 -> Ordering) -- ^ Comparison function.+    -> IO (Either Error ())+createCollation (Database db) (Utf8 name) cmp = mask_ $ do+    cmpPtr <- mkCCompare cmp'+    let u = castFunPtrToPtr cmpPtr+    BS.useAsCString name $ \namePtr ->+        toResult () <$> do+            r <- c_sqlite3_create_collation_v2+                db namePtr c_SQLITE_UTF8 u cmpPtr destroyCComparePtr+            -- sqlite does not call the destructor for us in case of an+            -- error+            unless (r == CError 0) $+                destroyCCompare $ castFunPtrToPtr cmpPtr+            return r+  where+    cmp' _ len1 ptr1 len2 ptr2 = handle exnHandler $ do+        s1 <- Utf8 <$> packCStringLen ptr1 len1+        s2 <- Utf8 <$> packCStringLen ptr2 len2+        let c = cmp s1 s2+        evaluate (fromIntegral $ fromEnum c - 1)+    exnHandler (_ :: SomeException) = return (-1)++-- | Delete a collation.+deleteCollation :: Database -> Utf8 -> IO (Either Error ())+deleteCollation (Database db) (Utf8 name) =+    BS.useAsCString name $ \namePtr ->+        toResult () <$> do+            c_sqlite3_create_collation_v2+                db namePtr c_SQLITE_UTF8 nullPtr nullFunPtr nullFunPtr++-- | <http://www.sqlite.org/c3ref/enable_load_extension.html>+--+-- Enable or disable extension loading.+setLoadExtensionEnabled :: Database -> Bool -> IO (Either Error ())+setLoadExtensionEnabled (Database db) enabled = do+    toResult () <$> c_sqlite3_enable_load_extension db enabled

file too large to diff

@@ -107,9 +107,9 @@ ** [sqlite3_libversion_number()], [sqlite3_sourceid()], ** [sqlite_version()] and [sqlite_source_id()]. */-#define SQLITE_VERSION        "3.8.4.1"-#define SQLITE_VERSION_NUMBER 3008004-#define SQLITE_SOURCE_ID      "2014-03-11 15:27:36 018d317b1257ce68a92908b05c9c7cf1494050d0"+#define SQLITE_VERSION        "3.8.5"+#define SQLITE_VERSION_NUMBER 3008005+#define SQLITE_SOURCE_ID      "2014-06-04 14:06:34 b1ed4f2a34ba66c29b130f8d13e9092758019212"  /* ** CAPI3REF: Run-Time Library Version Numbers@@ -560,7 +560,10 @@ ** file that were written at the application level might have changed ** and that adjacent bytes, even bytes within the same sector are ** guaranteed to be unchanged.  The SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN-** flag indicate that a file cannot be deleted when open.+** flag indicate that a file cannot be deleted when open.  The+** SQLITE_IOCAP_IMMUTABLE flag indicates that the file is on+** read-only media and cannot be changed even by processes with+** elevated privileges. */ #define SQLITE_IOCAP_ATOMIC                 0x00000001 #define SQLITE_IOCAP_ATOMIC512              0x00000002@@ -575,6 +578,7 @@ #define SQLITE_IOCAP_SEQUENTIAL             0x00000400 #define SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN  0x00000800 #define SQLITE_IOCAP_POWERSAFE_OVERWRITE    0x00001000+#define SQLITE_IOCAP_IMMUTABLE              0x00002000  /* ** CAPI3REF: File Locking Levels@@ -943,6 +947,12 @@ ** on whether or not the file has been renamed, moved, or deleted since it ** was first opened. **+** <li>[[SQLITE_FCNTL_WIN32_SET_HANDLE]]+** The [SQLITE_FCNTL_WIN32_SET_HANDLE] opcode is used for debugging.  This+** opcode causes the xFileControl method to swap the file handle with the one+** pointed to by the pArg argument.  This capability is used during testing+** and only needs to be supported when SQLITE_TEST is defined.+** ** </ul> */ #define SQLITE_FCNTL_LOCKSTATE               1@@ -966,6 +976,7 @@ #define SQLITE_FCNTL_HAS_MOVED              20 #define SQLITE_FCNTL_SYNC                   21 #define SQLITE_FCNTL_COMMIT_PHASETWO        22+#define SQLITE_FCNTL_WIN32_SET_HANDLE       23  /* ** CAPI3REF: Mutex Handle@@ -2779,6 +2790,30 @@ **     ^If sqlite3_open_v2() is used and the "cache" parameter is present in **     a URI filename, its value overrides any behavior requested by setting **     SQLITE_OPEN_PRIVATECACHE or SQLITE_OPEN_SHAREDCACHE flag.+**+**  <li> <b>psow</b>: ^The psow parameter may be "true" (or "on" or "yes" or+**     "1") or "false" (or "off" or "no" or "0") to indicate that the+**     [powersafe overwrite] property does or does not apply to the+**     storage media on which the database file resides.  ^The psow query+**     parameter only works for the built-in unix and Windows VFSes.+**+**  <li> <b>nolock</b>: ^The nolock parameter is a boolean query parameter+**     which if set disables file locking in rollback journal modes.  This+**     is useful for accessing a database on a filesystem that does not+**     support locking.  Caution:  Database corruption might result if two+**     or more processes write to the same database and any one of those+**     processes uses nolock=1.+**+**  <li> <b>immutable</b>: ^The immutable parameter is a boolean query+**     parameter that indicates that the database file is stored on+**     read-only media.  ^When immutable is set, SQLite assumes that the+**     database file cannot be changed, even by a process with higher+**     privilege, and so the database is opened read-only and all locking+**     and change detection is disabled.  Caution: Setting the immutable+**     property on a database file that does in fact change can result+**     in incorrect query results and/or [SQLITE_CORRUPT] errors.+**     See also: [SQLITE_IOCAP_IMMUTABLE].+**        ** </ul> ** ** ^Specifying an unknown parameter in the query component of a URI is not an@@ -2808,8 +2843,9 @@ **          Open file "data.db" in the current directory for read-only access. **          Regardless of whether or not shared-cache mode is enabled by **          default, use a private cache.-** <tr><td> file:/home/fred/data.db?vfs=unix-nolock <td>-**          Open file "/home/fred/data.db". Use the special VFS "unix-nolock".+** <tr><td> file:/home/fred/data.db?vfs=unix-dotfile <td>+**          Open file "/home/fred/data.db". Use the special VFS "unix-dotfile"+**          that uses dot-files in place of posix advisory locking. ** <tr><td> file:data.db?mode=readonly <td>  **          An error. "readonly" is not a valid option for the "mode" parameter. ** </table>@@ -6123,7 +6159,8 @@ #define SQLITE_TESTCTRL_EXPLAIN_STMT            19 #define SQLITE_TESTCTRL_NEVER_CORRUPT           20 #define SQLITE_TESTCTRL_VDBE_COVERAGE           21-#define SQLITE_TESTCTRL_LAST                    21+#define SQLITE_TESTCTRL_BYTEORDER               22+#define SQLITE_TESTCTRL_LAST                    22  /* ** CAPI3REF: SQLite Runtime Status@@ -7346,7 +7383,17 @@ #endif  typedef struct sqlite3_rtree_geometry sqlite3_rtree_geometry;+typedef struct sqlite3_rtree_query_info sqlite3_rtree_query_info; +/* The double-precision datatype used by RTree depends on the+** SQLITE_RTREE_INT_ONLY compile-time option.+*/+#ifdef SQLITE_RTREE_INT_ONLY+  typedef sqlite3_int64 sqlite3_rtree_dbl;+#else+  typedef double sqlite3_rtree_dbl;+#endif+ /* ** Register a geometry callback named zGeom that can be used as part of an ** R-Tree geometry query as follows:@@ -7356,11 +7403,7 @@ SQLITE_API int sqlite3_rtree_geometry_callback(   sqlite3 *db,   const char *zGeom,-#ifdef SQLITE_RTREE_INT_ONLY-  int (*xGeom)(sqlite3_rtree_geometry*, int n, sqlite3_int64 *a, int *pRes),-#else-  int (*xGeom)(sqlite3_rtree_geometry*, int n, double *a, int *pRes),-#endif+  int (*xGeom)(sqlite3_rtree_geometry*, int, sqlite3_rtree_dbl*,int*),   void *pContext ); @@ -7372,10 +7415,59 @@ struct sqlite3_rtree_geometry {   void *pContext;                 /* Copy of pContext passed to s_r_g_c() */   int nParam;                     /* Size of array aParam[] */-  double *aParam;                 /* Parameters passed to SQL geom function */+  sqlite3_rtree_dbl *aParam;      /* Parameters passed to SQL geom function */   void *pUser;                    /* Callback implementation user data */   void (*xDelUser)(void *);       /* Called by SQLite to clean up pUser */ };++/*+** Register a 2nd-generation geometry callback named zScore that can be +** used as part of an R-Tree geometry query as follows:+**+**   SELECT ... FROM <rtree> WHERE <rtree col> MATCH $zQueryFunc(... params ...)+*/+SQLITE_API int sqlite3_rtree_query_callback(+  sqlite3 *db,+  const char *zQueryFunc,+  int (*xQueryFunc)(sqlite3_rtree_query_info*),+  void *pContext,+  void (*xDestructor)(void*)+);+++/*+** A pointer to a structure of the following type is passed as the +** argument to scored geometry callback registered using+** sqlite3_rtree_query_callback().+**+** Note that the first 5 fields of this structure are identical to+** sqlite3_rtree_geometry.  This structure is a subclass of+** sqlite3_rtree_geometry.+*/+struct sqlite3_rtree_query_info {+  void *pContext;                   /* pContext from when function registered */+  int nParam;                       /* Number of function parameters */+  sqlite3_rtree_dbl *aParam;        /* value of function parameters */+  void *pUser;                      /* callback can use this, if desired */+  void (*xDelUser)(void*);          /* function to free pUser */+  sqlite3_rtree_dbl *aCoord;        /* Coordinates of node or entry to check */+  unsigned int *anQueue;            /* Number of pending entries in the queue */+  int nCoord;                       /* Number of coordinates */+  int iLevel;                       /* Level of current node or entry */+  int mxLevel;                      /* The largest iLevel value in the tree */+  sqlite3_int64 iRowid;             /* Rowid for current entry */+  sqlite3_rtree_dbl rParentScore;   /* Score of parent node */+  int eParentWithin;                /* Visibility of parent node */+  int eWithin;                      /* OUT: Visiblity */+  sqlite3_rtree_dbl rScore;         /* OUT: Write the score here */+};++/*+** Allowed values for sqlite3_rtree_query.eWithin and .eParentWithin.+*/+#define NOT_WITHIN       0   /* Object completely outside of query region */+#define PARTLY_WITHIN    1   /* Object partially overlaps query region */+#define FULLY_WITHIN     2   /* Object fully contained within query region */   #ifdef __cplusplus

@@ -1,6 +1,17 @@+v2.3.14+	* Add custom functions, aggregates and collations.++	* Upgrade the bundled SQLite3 library to 3.8.5.++	* Add bindings for controlling whether extension loading is+	  enabled or disabled.++	* Bump text and bytestring versions (actually, risking it and+	  removing upper bounds)+ v2.3.13-    * Add support for named parameters to queries.  Split this changelog into-      a separate file (preserving its history).+	* Add support for named parameters to queries.  Split this changelog into+	  a separate file (preserving its history).  v2.3.12 	* Upgrade bundled SQLite3 to 3.8.4.1.

@@ -1,12 +1,12 @@ name: direct-sqlite-version: 2.3.13+version: 2.3.14 build-type: Simple license: BSD3 license-file: LICENSE copyright: Copyright (c) 2012, 2013 Irene Knapp author: Irene Knapp <irene.knapp@icloud.com>-maintainer: irene.knapp@icloud.com-homepage: http://ireneknapp.com/software/+maintainer: Janne Hellsten <jjhellst@gmail.com>+homepage: https://github.com/IreneKnapp/direct-sqlite bug-reports: https://github.com/IreneKnapp/direct-sqlite/issues/new category: Database synopsis: Low-level binding to SQLite3.  Includes UTF8 and BLOB support.@@ -74,8 +74,8 @@    include-dirs: .   build-depends: base >= 4.1 && < 5,-                 bytestring >= 0.9.2.1 && < 1,-                 text >= 0.11 && < 1.2+                 bytestring >= 0.9.2.1,+                 text >= 0.11   ghc-options: -Wall -fwarn-tabs   default-language: Haskell2010 

@@ -9,6 +9,7 @@ import Data.Text            (Text) import Data.Text.Encoding.Error (UnicodeException(..)) import Data.Typeable+import Data.Monoid import System.Directory import System.Exit          (exitFailure) import System.IO@@ -55,6 +56,10 @@     , TestLabel "GetAutoCommit" . testGetAutoCommit     , TestLabel "Debug"         . testStatementSql     , TestLabel "Debug"         . testTracing+    , TestLabel "CustomFunc"    . testCustomFunction+    , TestLabel "CustomFuncErr" . testCustomFunctionError+    , TestLabel "CustomAggr"    . testCustomAggragate+    , TestLabel "CustomColl"    . testCustomCollation     ] ++     (if rtsSupportsBoundThreads then     [ TestLabel "Interrupt"     . testInterrupt@@ -718,6 +723,80 @@   withStmt conn q1 $ \stmt -> do     Just (Direct.Utf8 sql1) <- Direct.statementSql stmt     T.encodeUtf8 q1 @=? sql1++testCustomFunction :: TestEnv -> Test+testCustomFunction TestEnv{..} = TestCase $ do+  withConn $ \conn -> do+    createFunction conn "repeat" (Just 2) True repeatString+    withStmt conn "SELECT repeat(3,'abc')" $ \stmt -> do+      Row <- step stmt+      [SQLText "abcabcabc"] <- columns stmt+      Done <- step stmt+      return ()+    deleteFunction conn "repeat" (Just 2)+    Left SQLError{sqlError = ErrorError} <-+        try $ exec conn "SELECT repeat(3,'abc')"+    return ()+  where+    repeatString ctx args = do+        n <- funcArgInt64 args 0+        s <- funcArgText args 1+        funcResultText ctx $ T.concat $ replicate (fromIntegral n) s++testCustomFunctionError :: TestEnv -> Test+testCustomFunctionError TestEnv{..} = TestCase $ do+  withConn $ \conn -> do+    createFunction conn "fail" (Just 0) True throwError+    Left SQLError{..} <- try $ exec conn "SELECT fail()"+    assertBool "Catch exception"+        (sqlError == ErrorError && sqlErrorDetails == "error message")+  where+    throwError _ _ = error "error message"++testCustomAggragate :: TestEnv -> Test+testCustomAggragate TestEnv{..} = TestCase $ do+  withConn $ \conn -> do+    exec conn "CREATE TABLE tbl (n INT)"+    exec conn "INSERT INTO tbl(n) VALUES (12), (-3), (7)"+    createAggregate conn "mysum" (Just 1) 0 mySumStep funcResultInt64+    withStmt conn "SELECT mysum(n) FROM tbl" $ \stmt -> do+      Row <- step stmt+      [SQLInteger 16] <- columns stmt+      Done <- step stmt+      return ()+    deleteFunction conn "mysum" (Just 1)+    Left SQLError{sqlError = ErrorError} <-+        try $ exec conn "SELECT mysum(n) FROM tbl"+    return ()+  where+    mySumStep _ args s = do+        n <- funcArgInt64 args 0+        return (s + n)++testCustomCollation :: TestEnv -> Test+testCustomCollation TestEnv{..} = TestCase $ do+  withConn $ \conn -> do+    exec conn "CREATE TABLE tbl (n TEXT)"+    exec conn "INSERT INTO tbl(n) VALUES ('dog'),('mouse'),('ox'),('cat')"+    createCollation conn "len" cmpLen+    withStmt conn "SELECT * FROM tbl ORDER BY n COLLATE len" $ \stmt -> do+      Row <- step stmt+      [SQLText "ox"] <- columns stmt+      Row <- step stmt+      [SQLText "cat"] <- columns stmt+      Row <- step stmt+      [SQLText "dog"] <- columns stmt+      Row <- step stmt+      [SQLText "mouse"] <- columns stmt+      Done <- step stmt+      return ()+    deleteCollation conn "len"+    Left SQLError{sqlError = ErrorError} <-+        try $ exec conn "SELECT * FROM tbl ORDER BY n COLLATE len"+    return ()+  where+    -- order by length first, then by lexicographical order+    cmpLen s1 s2 = compare (T.length s1) (T.length s2) <> compare s1 s2  testInterrupt :: TestEnv -> Test testInterrupt TestEnv{..} = TestCase $