{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
-- |
-- This API is a slightly lower-level version of "Database.SQLite3".  Namely:
--
--  * It returns errors instead of throwing them.
--
--  * It only uses cheap conversions.  None of these bindings convert from
--    'String' or 'T.Text'.
module Database.SQLite3.Direct (
    -- * Connection management
    open,
    open2,
    close,
    errcode,
    extendedErrcode,
    errmsg,
    setTrace,
    getAutoCommit,
    setSharedCacheEnabled,

    -- * Simple query execution
    -- | <https://sqlite.org/c3ref/exec.html>
    exec,
    execWithCallback,
    ExecCallback,

    -- * Statement management
    prepare,
    getStatementDatabase,
    step,
    stepNoCB,
    reset,
    finalize,
    clearBindings,
    statementSql,

    -- * Parameter and column information
    bindParameterCount,
    bindParameterName,
    bindParameterIndex,
    columnCount,
    columnName,

    -- * Binding values to a prepared statement
    -- | <https://www.sqlite.org/c3ref/bind_blob.html>
    bindInt64,
    bindDouble,
    bindText,
    bindBlob,
    bindZeroBlob,
    bindNull,

    -- * Reading the result row
    -- | <https://www.sqlite.org/c3ref/column_blob.html>
    columnType,
    columnInt64,
    columnDouble,
    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,
    funcResultZeroBlob,
    funcResultNull,
    getFuncContextDatabase,

    -- * Create custom collations
    createCollation,
    deleteCollation,

    -- * Interrupting a long-running query
    interrupt,

    -- * Incremental blob I/O
    blobOpen,
    blobClose,
    blobReopen,
    blobBytes,
    blobRead,
    blobReadBuf,
    blobWrite,

    -- * Online Backup API
    -- | <https://www.sqlite.org/backup.html> and
    -- <https://www.sqlite.org/c3ref/backup_finish.html>
    backupInit,
    backupFinish,
    backupStep,
    backupRemaining,
    backupPagecount,

    -- * Types
    Database(..),
    Statement(..),
    ColumnType(..),
    FuncContext(..),
    FuncArgs(..),
    Blob(..),
    Backup(..),

    -- ** Results and errors
    StepResult(..),
    BackupStepResult(..),
    Error(..),

    -- ** Special types
    Utf8(..),
    ParamIndex(..),
    ColumnIndex(..),
    ColumnCount,
    ArgCount(..),
    ArgIndex,
) where

import           Control.Exception as E
import           Control.Monad (join, unless)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Unsafe as BSU
import           Data.IORef
import           Data.String (IsString(..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           Data.Text.Encoding.Error (lenientDecode)
import           Database.SQLite3.Bindings
import           Foreign
import           Foreign.C
import qualified System.IO.Unsafe as IOU

newtype Database = Database (Ptr CDatabase)
    deriving (Database -> Database -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Database -> Database -> Bool
$c/= :: Database -> Database -> Bool
== :: Database -> Database -> Bool
$c== :: Database -> Database -> Bool
Eq, Int -> Database -> ShowS
[Database] -> ShowS
Database -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Database] -> ShowS
$cshowList :: [Database] -> ShowS
show :: Database -> String
$cshow :: Database -> String
showsPrec :: Int -> Database -> ShowS
$cshowsPrec :: Int -> Database -> ShowS
Show)

newtype Statement = Statement (Ptr CStatement)
    deriving (Statement -> Statement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)

data StepResult
    = Row
    | Done
    deriving (StepResult -> StepResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepResult -> StepResult -> Bool
$c/= :: StepResult -> StepResult -> Bool
== :: StepResult -> StepResult -> Bool
$c== :: StepResult -> StepResult -> Bool
Eq, Int -> StepResult -> ShowS
[StepResult] -> ShowS
StepResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepResult] -> ShowS
$cshowList :: [StepResult] -> ShowS
show :: StepResult -> String
$cshow :: StepResult -> String
showsPrec :: Int -> StepResult -> ShowS
$cshowsPrec :: Int -> StepResult -> ShowS
Show)

data BackupStepResult
    = BackupOK   -- ^ There are still more pages to be copied.
    | BackupDone -- ^ All pages were successfully copied.
    deriving (BackupStepResult -> BackupStepResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackupStepResult -> BackupStepResult -> Bool
$c/= :: BackupStepResult -> BackupStepResult -> Bool
== :: BackupStepResult -> BackupStepResult -> Bool
$c== :: BackupStepResult -> BackupStepResult -> Bool
Eq, Int -> BackupStepResult -> ShowS
[BackupStepResult] -> ShowS
BackupStepResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackupStepResult] -> ShowS
$cshowList :: [BackupStepResult] -> ShowS
show :: BackupStepResult -> String
$cshow :: BackupStepResult -> String
showsPrec :: Int -> BackupStepResult -> ShowS
$cshowsPrec :: Int -> BackupStepResult -> ShowS
Show)

-- | A 'ByteString' containing UTF8-encoded text with no NUL characters.
newtype Utf8 = Utf8 ByteString
    deriving (Utf8 -> Utf8 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Utf8 -> Utf8 -> Bool
$c/= :: Utf8 -> Utf8 -> Bool
== :: Utf8 -> Utf8 -> Bool
$c== :: Utf8 -> Utf8 -> Bool
Eq, Eq Utf8
Utf8 -> Utf8 -> Bool
Utf8 -> Utf8 -> Ordering
Utf8 -> Utf8 -> Utf8
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Utf8 -> Utf8 -> Utf8
$cmin :: Utf8 -> Utf8 -> Utf8
max :: Utf8 -> Utf8 -> Utf8
$cmax :: Utf8 -> Utf8 -> Utf8
>= :: Utf8 -> Utf8 -> Bool
$c>= :: Utf8 -> Utf8 -> Bool
> :: Utf8 -> Utf8 -> Bool
$c> :: Utf8 -> Utf8 -> Bool
<= :: Utf8 -> Utf8 -> Bool
$c<= :: Utf8 -> Utf8 -> Bool
< :: Utf8 -> Utf8 -> Bool
$c< :: Utf8 -> Utf8 -> Bool
compare :: Utf8 -> Utf8 -> Ordering
$ccompare :: Utf8 -> Utf8 -> Ordering
Ord, NonEmpty Utf8 -> Utf8
Utf8 -> Utf8 -> Utf8
forall b. Integral b => b -> Utf8 -> Utf8
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Utf8 -> Utf8
$cstimes :: forall b. Integral b => b -> Utf8 -> Utf8
sconcat :: NonEmpty Utf8 -> Utf8
$csconcat :: NonEmpty Utf8 -> Utf8
<> :: Utf8 -> Utf8 -> Utf8
$c<> :: Utf8 -> Utf8 -> Utf8
Semigroup, Semigroup Utf8
Utf8
[Utf8] -> Utf8
Utf8 -> Utf8 -> Utf8
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Utf8] -> Utf8
$cmconcat :: [Utf8] -> Utf8
mappend :: Utf8 -> Utf8 -> Utf8
$cmappend :: Utf8 -> Utf8 -> Utf8
mempty :: Utf8
$cmempty :: Utf8
Monoid)

instance Show Utf8 where
    show :: Utf8 -> String
show (Utf8 ByteString
s) = (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
lenientDecode) ByteString
s

-- | @fromString = Utf8 . 'T.encodeUtf8' . 'T.pack'@
instance IsString Utf8 where
    fromString :: String -> Utf8
fromString = ByteString -> Utf8
Utf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

packUtf8 :: a -> (Utf8 -> a) -> CString -> IO a
packUtf8 :: forall a. a -> (Utf8 -> a) -> Ptr CChar -> IO a
packUtf8 a
n Utf8 -> a
f Ptr CChar
cstr | Ptr CChar
cstr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall (m :: * -> *) a. Monad m => a -> m a
return a
n
                  | Bool
otherwise       = Utf8 -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Utf8
Utf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
cstr

packCStringLen :: CString -> CNumBytes -> IO ByteString
packCStringLen :: Ptr CChar -> CNumBytes -> IO ByteString
packCStringLen Ptr CChar
cstr CNumBytes
len =
    CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
cstr, forall a b. (Integral a, Num b) => a -> b
fromIntegral CNumBytes
len)

packUtf8Array :: IO a -> (Utf8 -> IO a) -> Int -> Ptr CString -> IO [a]
packUtf8Array :: forall a.
IO a -> (Utf8 -> IO a) -> Int -> Ptr (Ptr CChar) -> IO [a]
packUtf8Array IO a
onNull Utf8 -> IO a
onUtf8 Int
count Ptr (Ptr CChar)
base =
    forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr (Ptr CChar)
base forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> (Utf8 -> a) -> Ptr CChar -> IO a
packUtf8 IO a
onNull Utf8 -> IO a
onUtf8)

-- | Like 'unsafeUseAsCStringLen', but if the string is empty,
-- never pass the callback a null pointer.
unsafeUseAsCStringLenNoNull :: ByteString -> (CString -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull :: forall a. ByteString -> (Ptr CChar -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
bs Ptr CChar -> CNumBytes -> IO a
cb
    | ByteString -> Bool
BS.null ByteString
bs = Ptr CChar -> CNumBytes -> IO a
cb (forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
1) CNumBytes
0
    | Bool
otherwise  = forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
                       Ptr CChar -> CNumBytes -> IO a
cb Ptr CChar
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

wrapNullablePtr :: (Ptr a -> b) -> Ptr a -> Maybe b
wrapNullablePtr :: forall a b. (Ptr a -> b) -> Ptr a -> Maybe b
wrapNullablePtr Ptr a -> b
f Ptr a
ptr | Ptr a
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall a. Maybe a
Nothing
                      | Bool
otherwise      = forall a. a -> Maybe a
Just (Ptr a -> b
f Ptr a
ptr)

-- Convert a 'CError' to a 'Either Error', in the common case where
-- SQLITE_OK signals success and anything else signals an error.
--
-- Note that SQLITE_OK == 0.
toResult :: a -> CError -> Either Error a
toResult :: forall a. a -> CError -> Either Error a
toResult a
a (CError CInt
0) = forall a b. b -> Either a b
Right a
a
toResult a
_ CError
code       = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CError -> Error
decodeError CError
code

-- Only perform the action if the 'CError' is SQLITE_OK.
toResultM :: Monad m => m a -> CError -> m (Either Error a)
toResultM :: forall (m :: * -> *) a.
Monad m =>
m a -> CError -> m (Either Error a)
toResultM m a
m (CError CInt
0) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m
toResultM m a
_ CError
code       = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ CError -> Error
decodeError CError
code

toStepResult :: CError -> Either Error StepResult
toStepResult :: CError -> Either Error StepResult
toStepResult CError
code =
    case CError -> Error
decodeError CError
code of
        Error
ErrorRow  -> forall a b. b -> Either a b
Right StepResult
Row
        Error
ErrorDone -> forall a b. b -> Either a b
Right StepResult
Done
        Error
err       -> forall a b. a -> Either a b
Left Error
err

toBackupStepResult :: CError -> Either Error BackupStepResult
toBackupStepResult :: CError -> Either Error BackupStepResult
toBackupStepResult CError
code =
    case CError -> Error
decodeError CError
code of
        Error
ErrorOK   -> forall a b. b -> Either a b
Right BackupStepResult
BackupOK
        Error
ErrorDone -> forall a b. b -> Either a b
Right BackupStepResult
BackupDone
        Error
err       -> forall a b. a -> Either a b
Left Error
err

-- | The context in which a custom SQL function is executed.
newtype FuncContext = FuncContext (Ptr CContext)
    deriving (FuncContext -> FuncContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuncContext -> FuncContext -> Bool
$c/= :: FuncContext -> FuncContext -> Bool
== :: FuncContext -> FuncContext -> Bool
$c== :: FuncContext -> FuncContext -> Bool
Eq, Int -> FuncContext -> ShowS
[FuncContext] -> ShowS
FuncContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuncContext] -> ShowS
$cshowList :: [FuncContext] -> ShowS
show :: FuncContext -> String
$cshow :: FuncContext -> String
showsPrec :: Int -> FuncContext -> ShowS
$cshowsPrec :: Int -> FuncContext -> ShowS
Show)

-- | The arguments of a custom SQL function.
data FuncArgs = FuncArgs CArgCount (Ptr (Ptr CValue))

-- | The type of blob handles used for incremental blob I/O
data Blob = Blob Database (Ptr CBlob) -- we include the db handle to use in
    deriving (Blob -> Blob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blob -> Blob -> Bool
$c/= :: Blob -> Blob -> Bool
== :: Blob -> Blob -> Bool
$c== :: Blob -> Blob -> Bool
Eq, Int -> Blob -> ShowS
[Blob] -> ShowS
Blob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Blob] -> ShowS
$cshowList :: [Blob] -> ShowS
show :: Blob -> String
$cshow :: Blob -> String
showsPrec :: Int -> Blob -> ShowS
$cshowsPrec :: Int -> Blob -> ShowS
Show)               -- error messages since it cannot
                                      -- be retrieved any other way

-- | A handle for an online backup process.
data Backup = Backup Database (Ptr CBackup)
    deriving (Backup -> Backup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backup -> Backup -> Bool
$c/= :: Backup -> Backup -> Bool
== :: Backup -> Backup -> Bool
$c== :: Backup -> Backup -> Bool
Eq, Int -> Backup -> ShowS
[Backup] -> ShowS
Backup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backup] -> ShowS
$cshowList :: [Backup] -> ShowS
show :: Backup -> String
$cshow :: Backup -> String
showsPrec :: Int -> Backup -> ShowS
$cshowsPrec :: Int -> Backup -> ShowS
Show)
-- we include the destination db handle to use in error messages since
-- it cannot be retrieved any other way

------------------------------------------------------------------------

-- | <https://www.sqlite.org/c3ref/open.html>
open :: Utf8 -> IO (Either (Error, Utf8) Database)
open :: Utf8 -> IO (Either (Error, Utf8) Database)
open (Utf8 ByteString
path) =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
path forall a b. (a -> b) -> a -> b
$ \Ptr CChar
path' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CDatabase)
database -> do
        CError
rc <- Ptr CChar -> Ptr (Ptr CDatabase) -> IO CError
c_sqlite3_open Ptr CChar
path' Ptr (Ptr CDatabase)
database
        CError -> Ptr (Ptr CDatabase) -> IO (Either (Error, Utf8) Database)
openHelper CError
rc Ptr (Ptr CDatabase)
database

-- | <https://www.sqlite.org/c3ref/open.html>
open2 :: Utf8 -> Int -> Maybe Utf8 -> IO (Either (Error, Utf8) Database)
open2 :: Utf8 -> Int -> Maybe Utf8 -> IO (Either (Error, Utf8) Database)
open2 (Utf8 ByteString
path) Int
flags Maybe Utf8
mzvfs =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
path forall a b. (a -> b) -> a -> b
$ \Ptr CChar
path' ->
    forall a. Maybe Utf8 -> (Ptr CChar -> IO a) -> IO a
useAsMaybeCString Maybe Utf8
mzvfs forall a b. (a -> b) -> a -> b
$ \Ptr CChar
zvfs' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CDatabase)
database -> do
        CError
rc <- Ptr CChar -> Ptr (Ptr CDatabase) -> CInt -> Ptr CChar -> IO CError
c_sqlite3_open_v2 Ptr CChar
path' Ptr (Ptr CDatabase)
database (forall a. Enum a => Int -> a
toEnum Int
flags) Ptr CChar
zvfs'
        CError -> Ptr (Ptr CDatabase) -> IO (Either (Error, Utf8) Database)
openHelper CError
rc Ptr (Ptr CDatabase)
database

    where useAsMaybeCString :: Maybe Utf8 -> (CString -> IO a) -> IO a
          useAsMaybeCString :: forall a. Maybe Utf8 -> (Ptr CChar -> IO a) -> IO a
useAsMaybeCString (Just (Utf8 ByteString
zvfs)) Ptr CChar -> IO a
f = forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
zvfs Ptr CChar -> IO a
f
          useAsMaybeCString Maybe Utf8
_ Ptr CChar -> IO a
f = Ptr CChar -> IO a
f forall a. Ptr a
nullPtr

openHelper :: CError -> Ptr (Ptr CDatabase) -> IO (Either (Error, Utf8) Database)
openHelper :: CError -> Ptr (Ptr CDatabase) -> IO (Either (Error, Utf8) Database)
openHelper CError
rc Ptr (Ptr CDatabase)
database = do
    Database
db <- Ptr CDatabase -> Database
Database forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CDatabase)
database
        -- sqlite3_open and sqlite3_open_v2 return a sqlite3 even on failure.
        -- That's where we get a more descriptive error message.
    case forall a. a -> CError -> Either Error a
toResult () CError
rc of
        Left Error
err -> do
            Utf8
msg <- Database -> IO Utf8
errmsg Database
db -- This returns "out of memory" if db is null.
            Either Error ()
_   <- Database -> IO (Either Error ())
close Database
db  -- This is harmless if db is null.
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Error
err, Utf8
msg)
        Right () ->
            if Database
db forall a. Eq a => a -> a -> Bool
== Ptr CDatabase -> Database
Database forall a. Ptr a
nullPtr
                then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sqlite3_open unexpectedly returned NULL"
                else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Database
db

-- | <https://www.sqlite.org/c3ref/close.html>
close :: Database -> IO (Either Error ())
close :: Database -> IO (Either Error ())
close (Database Ptr CDatabase
db) =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDatabase -> IO CError
c_sqlite3_close Ptr CDatabase
db

-- | <https://www.sqlite.org/c3ref/interrupt.html>
--
-- Cause any pending operation on the 'Database' handle to stop at its earliest
-- opportunity.  This simply sets a flag and returns immediately.  It does not
-- wait for the pending operation to finish.
--
-- You'll need to compile with @-threaded@ for this to do any good.
-- Without @-threaded@, FFI calls block the whole RTS, meaning 'interrupt'
-- would never run at the same time as 'step'.
interrupt :: Database -> IO ()
interrupt :: Database -> IO ()
interrupt (Database Ptr CDatabase
db) =
    Ptr CDatabase -> IO ()
c_sqlite3_interrupt Ptr CDatabase
db

-- | <https://www.sqlite.org/c3ref/errcode.html>
errcode :: Database -> IO Error
errcode :: Database -> IO Error
errcode (Database Ptr CDatabase
db) =
    CError -> Error
decodeError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDatabase -> IO CError
c_sqlite3_errcode Ptr CDatabase
db

-- | <https://www.sqlite.org/c3ref/errcode.html>
extendedErrcode :: Database -> IO Error
extendedErrcode :: Database -> IO Error
extendedErrcode (Database Ptr CDatabase
db) =
    CError -> Error
decodeError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDatabase -> IO CError
c_sqlite3_extended_errcode Ptr CDatabase
db

-- | <https://www.sqlite.org/c3ref/errcode.html>
errmsg :: Database -> IO Utf8
errmsg :: Database -> IO Utf8
errmsg (Database Ptr CDatabase
db) =
    Ptr CDatabase -> IO (Ptr CChar)
c_sqlite3_errmsg Ptr CDatabase
db forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> (Utf8 -> a) -> Ptr CChar -> IO a
packUtf8 forall a. Monoid a => a
mempty forall a. a -> a
id

withErrorMessagePtr :: (Ptr CString -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr :: (Ptr (Ptr CChar) -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr Ptr (Ptr CChar) -> IO CError
action =
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
msgPtrOut -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
msgPtrOut forall a. Ptr a
nullPtr
        CError
rc <- forall a. IO a -> IO a
restore (Ptr (Ptr CChar) -> IO CError
action Ptr (Ptr CChar)
msgPtrOut)
            forall a b. IO a -> IO b -> IO a
`onException` (forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
msgPtrOut forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO ()
c_sqlite3_free)
        case forall a. a -> CError -> Either Error a
toResult () CError
rc of
            Left Error
err -> do
                Ptr CChar
msgPtr <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
msgPtrOut
                if Ptr CChar
msgPtr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
                    then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Error
err, forall a. Monoid a => a
mempty))
                    else do
                        CSize
len <- Ptr CChar -> IO CSize
BSI.c_strlen Ptr CChar
msgPtr
                        ForeignPtr CChar
fp <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
c_sqlite3_free_p Ptr CChar
msgPtr
                        let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
fp) Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Error
err, ByteString -> Utf8
Utf8 ByteString
bs))
            Right () -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ())

-- | <https://www.sqlite.org/c3ref/exec.html>
exec :: Database -> Utf8 -> IO (Either (Error, Utf8) ())
exec :: Database -> Utf8 -> IO (Either (Error, Utf8) ())
exec (Database Ptr CDatabase
db) (Utf8 ByteString
sql) =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
sql forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sql' ->
        (Ptr (Ptr CChar) -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr (forall a.
Ptr CDatabase
-> Ptr CChar
-> FunPtr (CExecCallback a)
-> Ptr a
-> Ptr (Ptr CChar)
-> IO CError
c_sqlite3_exec Ptr CDatabase
db Ptr CChar
sql' forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr)

-- | Like 'exec', but invoke the callback for each result row.
--
-- If the callback throws an exception, it will be rethrown by
-- 'execWithCallback'.
execWithCallback :: Database -> Utf8 -> ExecCallback -> IO (Either (Error, Utf8) ())
execWithCallback :: Database -> Utf8 -> ExecCallback -> IO (Either (Error, Utf8) ())
execWithCallback (Database Ptr CDatabase
db) (Utf8 ByteString
sql) ExecCallback
cb = do
    IORef (Maybe SomeException)
abortReason <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing :: IO (IORef (Maybe SomeException))
    IORef (Maybe ([Maybe Utf8] -> IO ()))
cbCache <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing :: IO (IORef (Maybe ([Maybe Utf8] -> IO ())))
        -- Cache the partial application of column count and name, so if the
        -- caller wants to convert them to something else, it only has to do
        -- the conversions once.

    let getCallback :: CColumnIndex -> Ptr (Ptr CChar) -> IO ([Maybe Utf8] -> IO ())
getCallback CColumnIndex
cCount Ptr (Ptr CChar)
cNames = do
            Maybe ([Maybe Utf8] -> IO ())
m <- forall a. IORef a -> IO a
readIORef IORef (Maybe ([Maybe Utf8] -> IO ()))
cbCache
            case Maybe ([Maybe Utf8] -> IO ())
m of
                Maybe ([Maybe Utf8] -> IO ())
Nothing -> do
                    [Utf8]
names <- forall a.
IO a -> (Utf8 -> IO a) -> Int -> Ptr (Ptr CChar) -> IO [a]
packUtf8Array (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"execWithCallback: NULL column name")
                                           forall (m :: * -> *) a. Monad m => a -> m a
return
                                           (forall a b. (Integral a, Num b) => a -> b
fromIntegral CColumnIndex
cCount) Ptr (Ptr CChar)
cNames
                    let !cb' :: [Maybe Utf8] -> IO ()
cb' = ExecCallback
cb (forall public ffi. FFIType public ffi => ffi -> public
fromFFI CColumnIndex
cCount) [Utf8]
names
                    forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ([Maybe Utf8] -> IO ()))
cbCache forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Maybe Utf8] -> IO ()
cb'
                    forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe Utf8] -> IO ()
cb'
                Just [Maybe Utf8] -> IO ()
cb' -> forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe Utf8] -> IO ()
cb'

    let onExceptionAbort :: IO a -> IO a
onExceptionAbort IO a
io =
          (IO a
io forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
0) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
ex -> do
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe SomeException)
abortReason forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeException
ex
            forall (m :: * -> *) a. Monad m => a -> m a
return a
1

    let cExecCallback :: p -> CColumnIndex -> Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> IO a
cExecCallback p
_ctx CColumnIndex
cCount Ptr (Ptr CChar)
cValues Ptr (Ptr CChar)
cNames =
          forall {a} {a}. Num a => IO a -> IO a
onExceptionAbort forall a b. (a -> b) -> a -> b
$ do
            [Maybe Utf8] -> IO ()
cb' <- CColumnIndex -> Ptr (Ptr CChar) -> IO ([Maybe Utf8] -> IO ())
getCallback CColumnIndex
cCount Ptr (Ptr CChar)
cNames
            [Maybe Utf8]
values <- forall a.
IO a -> (Utf8 -> IO a) -> Int -> Ptr (Ptr CChar) -> IO [a]
packUtf8Array (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
                                    (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
                                    (forall a b. (Integral a, Num b) => a -> b
fromIntegral CColumnIndex
cCount) Ptr (Ptr CChar)
cValues
            [Maybe Utf8] -> IO ()
cb' [Maybe Utf8]
values

    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
sql forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sql' ->
        forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. CExecCallback a -> IO (FunPtr (CExecCallback a))
mkCExecCallback forall {a} {p}.
Num a =>
p -> CColumnIndex -> Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> IO a
cExecCallback) forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr (CExecCallback Any)
pExecCallback -> do
            Either (Error, Utf8) ()
e <- (Ptr (Ptr CChar) -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr (forall a.
Ptr CDatabase
-> Ptr CChar
-> FunPtr (CExecCallback a)
-> Ptr a
-> Ptr (Ptr CChar)
-> IO CError
c_sqlite3_exec Ptr CDatabase
db Ptr CChar
sql' FunPtr (CExecCallback Any)
pExecCallback forall a. Ptr a
nullPtr)
            case Either (Error, Utf8) ()
e of
                Left r :: (Error, Utf8)
r@(Error
ErrorAbort, Utf8
_) -> do
                    Maybe SomeException
m <- forall a. IORef a -> IO a
readIORef IORef (Maybe SomeException)
abortReason
                    case Maybe SomeException
m of
                        Maybe SomeException
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Error, Utf8)
r)
                        Just SomeException
ex -> forall e a. Exception e => e -> IO a
throwIO SomeException
ex
                Either (Error, Utf8) ()
r               -> forall (m :: * -> *) a. Monad m => a -> m a
return Either (Error, Utf8) ()
r

type ExecCallback
     = ColumnCount    -- ^ Number of columns, which is the number of items in
                      --   the following lists.  This will be the same for
                      --   every row.
    -> [Utf8]         -- ^ List of column names.  This will be the same
                      --   for every row.
    -> [Maybe Utf8]   -- ^ List of column values, as returned by 'columnText'.
    -> IO ()

-- | <https://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 -> Maybe (Utf8 -> IO ()) -> IO ()
setTrace (Database Ptr CDatabase
db) Maybe (Utf8 -> IO ())
logger =
    case Maybe (Utf8 -> IO ())
logger of
        Maybe (Utf8 -> IO ())
Nothing -> do
            Ptr ()
_ <- forall a.
Ptr CDatabase -> FunPtr (CTraceCallback a) -> Ptr a -> IO (Ptr ())
c_sqlite3_trace Ptr CDatabase
db forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr
            forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Utf8 -> IO ()
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.
            FunPtr (CTraceCallback Any)
cb <- forall a. CTraceCallback a -> IO (FunPtr (CTraceCallback a))
mkCTraceCallback forall a b. (a -> b) -> a -> b
$ \Ptr Any
_ctx Ptr CChar
cStr -> do
                Utf8
msg <- forall a. a -> (Utf8 -> a) -> Ptr CChar -> IO a
packUtf8 forall a. Monoid a => a
mempty forall a. a -> a
id Ptr CChar
cStr
                Utf8 -> IO ()
output Utf8
msg
            Ptr ()
_ <- forall a.
Ptr CDatabase -> FunPtr (CTraceCallback a) -> Ptr a -> IO (Ptr ())
c_sqlite3_trace Ptr CDatabase
db FunPtr (CTraceCallback Any)
cb forall a. Ptr a
nullPtr
            forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | <https://www.sqlite.org/c3ref/get_autocommit.html>
--
-- Return 'True' if the connection is in autocommit mode, or 'False' if a
-- transaction started with @BEGIN@ is still active.
--
-- Be warned that some errors roll back the transaction automatically,
-- and that @ROLLBACK@ will throw an error if no transaction is active.
-- Use 'getAutoCommit' to avoid such an error:
--
-- @
--  autocommit <- 'getAutoCommit' conn
--  'Control.Monad.when' (not autocommit) $
--      'Database.SQLite3.exec' conn \"ROLLBACK\"
-- @
getAutoCommit :: Database -> IO Bool
getAutoCommit :: Database -> IO Bool
getAutoCommit (Database Ptr CDatabase
db) =
    (forall a. Eq a => a -> a -> Bool
/= CInt
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDatabase -> IO CInt
c_sqlite3_get_autocommit Ptr CDatabase
db

-- | <https://www.sqlite.org/c3ref/enable_shared_cache.html>
--
-- Enable or disable shared cache for all future connections.
setSharedCacheEnabled :: Bool -> IO (Either Error ())
setSharedCacheEnabled :: Bool -> IO (Either Error ())
setSharedCacheEnabled Bool
val =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO CError
c_sqlite3_enable_shared_cache Bool
val

-- | <https://www.sqlite.org/c3ref/prepare.html>
--
-- If the query contains no SQL statements, this returns
-- @'Right' 'Nothing'@.
prepare :: Database -> Utf8 -> IO (Either Error (Maybe Statement))
prepare :: Database -> Utf8 -> IO (Either Error (Maybe Statement))
prepare (Database Ptr CDatabase
db) (Utf8 ByteString
sql) =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
sql forall a b. (a -> b) -> a -> b
$ \Ptr CChar
sql' ->
        forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CStatement)
statement ->
            Ptr CDatabase
-> Ptr CChar
-> CNumBytes
-> Ptr (Ptr CStatement)
-> Ptr (Ptr CChar)
-> IO CError
c_sqlite3_prepare_v2 Ptr CDatabase
db Ptr CChar
sql' (-CNumBytes
1) Ptr (Ptr CStatement)
statement forall a. Ptr a
nullPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                forall (m :: * -> *) a.
Monad m =>
m a -> CError -> m (Either Error a)
toResultM (forall a b. (Ptr a -> b) -> Ptr a -> Maybe b
wrapNullablePtr Ptr CStatement -> Statement
Statement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CStatement)
statement)

-- | <https://www.sqlite.org/c3ref/db_handle.html>
getStatementDatabase :: Statement -> IO Database
getStatementDatabase :: Statement -> IO Database
getStatementDatabase (Statement Ptr CStatement
stmt) = do
    Ptr CDatabase
db <- Ptr CStatement -> IO (Ptr CDatabase)
c_sqlite3_db_handle Ptr CStatement
stmt
    if Ptr CDatabase
db forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
        then forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"sqlite3_db_handle(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Ptr CStatement
stmt forall a. [a] -> [a] -> [a]
++ String
") returned NULL"
        else forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CDatabase -> Database
Database Ptr CDatabase
db)

-- | <https://www.sqlite.org/c3ref/step.html>
step :: Statement -> IO (Either Error StepResult)
step :: Statement -> IO (Either Error StepResult)
step (Statement Ptr CStatement
stmt) =
    CError -> Either Error StepResult
toStepResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> IO CError
c_sqlite3_step Ptr CStatement
stmt

-- | <https://www.sqlite.org/c3ref/step.html>
--
-- Faster step for statements that don't callback to Haskell
-- functions (e.g. by using custom SQL functions).
stepNoCB :: Statement -> IO (Either Error StepResult)
stepNoCB :: Statement -> IO (Either Error StepResult)
stepNoCB (Statement Ptr CStatement
stmt) =
    CError -> Either Error StepResult
toStepResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> IO CError
c_sqlite3_step_unsafe Ptr CStatement
stmt

-- | <https://www.sqlite.org/c3ref/reset.html>
--
-- Warning:
--
--  * If the most recent 'step' call failed,
--    this will return the corresponding error.
--
--  * This does not reset the bindings on a prepared statement.
--    Use 'clearBindings' to do that.
reset :: Statement -> IO (Either Error ())
reset :: Statement -> IO (Either Error ())
reset (Statement Ptr CStatement
stmt) =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> IO CError
c_sqlite3_reset Ptr CStatement
stmt

-- | <https://www.sqlite.org/c3ref/finalize.html>
--
-- /Warning:/ If the most recent 'step' call failed,
-- this will return the corresponding error.
finalize :: Statement -> IO (Either Error ())
finalize :: Statement -> IO (Either Error ())
finalize (Statement Ptr CStatement
stmt) =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> IO CError
c_sqlite3_finalize Ptr CStatement
stmt

-- | <https://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 -> IO (Maybe Utf8)
statementSql (Statement Ptr CStatement
stmt) =
    Ptr CStatement -> IO (Ptr CChar)
c_sqlite3_sql Ptr CStatement
stmt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> (Utf8 -> a) -> Ptr CChar -> IO a
packUtf8 forall a. Maybe a
Nothing forall a. a -> Maybe a
Just

-- | <https://www.sqlite.org/c3ref/clear_bindings.html>
--
-- Set all parameters in the prepared statement to null.
clearBindings :: Statement -> IO ()
clearBindings :: Statement -> IO ()
clearBindings (Statement Ptr CStatement
stmt) = do
    CError
_ <- Ptr CStatement -> IO CError
c_sqlite3_clear_bindings Ptr CStatement
stmt
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | <https://www.sqlite.org/c3ref/bind_parameter_count.html>
--
-- This returns the index of the largest (rightmost) parameter.  Note that this
-- is not necessarily the number of parameters.  If numbered parameters like
-- @?5@ are used, there may be gaps in the list.
--
-- See 'ParamIndex' for more information.
bindParameterCount :: Statement -> IO ParamIndex
bindParameterCount :: Statement -> IO ParamIndex
bindParameterCount (Statement Ptr CStatement
stmt) =
    forall public ffi. FFIType public ffi => ffi -> public
fromFFI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> IO CParamIndex
c_sqlite3_bind_parameter_count Ptr CStatement
stmt

-- | <https://www.sqlite.org/c3ref/bind_parameter_name.html>
bindParameterName :: Statement -> ParamIndex -> IO (Maybe Utf8)
bindParameterName :: Statement -> ParamIndex -> IO (Maybe Utf8)
bindParameterName (Statement Ptr CStatement
stmt) ParamIndex
idx =
    Ptr CStatement -> CParamIndex -> IO (Ptr CChar)
c_sqlite3_bind_parameter_name Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        forall a. a -> (Utf8 -> a) -> Ptr CChar -> IO a
packUtf8 forall a. Maybe a
Nothing forall a. a -> Maybe a
Just

-- | <https://www.sqlite.org/c3ref/bind_parameter_index.html>
bindParameterIndex :: Statement -> Utf8 -> IO (Maybe ParamIndex)
bindParameterIndex :: Statement -> Utf8 -> IO (Maybe ParamIndex)
bindParameterIndex (Statement Ptr CStatement
stmt) (Utf8 ByteString
name) =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name forall a b. (a -> b) -> a -> b
$ \Ptr CChar
name' -> do
        ParamIndex
idx <- forall public ffi. FFIType public ffi => ffi -> public
fromFFI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> Ptr CChar -> IO CParamIndex
c_sqlite3_bind_parameter_index Ptr CStatement
stmt Ptr CChar
name'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if ParamIndex
idx forall a. Eq a => a -> a -> Bool
== ParamIndex
0 then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just ParamIndex
idx

-- | <https://www.sqlite.org/c3ref/column_count.html>
columnCount :: Statement -> IO ColumnCount
columnCount :: Statement -> IO ColumnIndex
columnCount (Statement Ptr CStatement
stmt) =
    forall public ffi. FFIType public ffi => ffi -> public
fromFFI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> IO CColumnIndex
c_sqlite3_column_count Ptr CStatement
stmt

-- | <https://www.sqlite.org/c3ref/column_name.html>
columnName :: Statement -> ColumnIndex -> IO (Maybe Utf8)
columnName :: Statement -> ColumnIndex -> IO (Maybe Utf8)
columnName (Statement Ptr CStatement
stmt) ColumnIndex
idx =
    Ptr CStatement -> CColumnIndex -> IO (Ptr CChar)
c_sqlite3_column_name Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        forall a. a -> (Utf8 -> a) -> Ptr CChar -> IO a
packUtf8 forall a. Maybe a
Nothing forall a. a -> Maybe a
Just

bindInt64 :: Statement -> ParamIndex -> Int64 -> IO (Either Error ())
bindInt64 :: Statement -> ParamIndex -> Int64 -> IO (Either Error ())
bindInt64 (Statement Ptr CStatement
stmt) ParamIndex
idx Int64
value =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> CParamIndex -> Int64 -> IO CError
c_sqlite3_bind_int64 Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) Int64
value

bindDouble :: Statement -> ParamIndex -> Double -> IO (Either Error ())
bindDouble :: Statement -> ParamIndex -> Double -> IO (Either Error ())
bindDouble (Statement Ptr CStatement
stmt) ParamIndex
idx Double
value =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> CParamIndex -> Double -> IO CError
c_sqlite3_bind_double Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) Double
value

bindText :: Statement -> ParamIndex -> Utf8 -> IO (Either Error ())
bindText :: Statement -> ParamIndex -> Utf8 -> IO (Either Error ())
bindText (Statement Ptr CStatement
stmt) ParamIndex
idx (Utf8 ByteString
value) =
    forall a. ByteString -> (Ptr CChar -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr CNumBytes
len ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CStatement
-> CParamIndex
-> Ptr CChar
-> CNumBytes
-> Ptr CDestructor
-> IO CError
c_sqlite3_bind_text Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) Ptr CChar
ptr CNumBytes
len Ptr CDestructor
c_SQLITE_TRANSIENT

bindBlob :: Statement -> ParamIndex -> ByteString -> IO (Either Error ())
bindBlob :: Statement -> ParamIndex -> ByteString -> IO (Either Error ())
bindBlob (Statement Ptr CStatement
stmt) ParamIndex
idx ByteString
value =
    forall a. ByteString -> (Ptr CChar -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr CNumBytes
len ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall a.
Ptr CStatement
-> CParamIndex
-> Ptr a
-> CNumBytes
-> Ptr CDestructor
-> IO CError
c_sqlite3_bind_blob Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) Ptr CChar
ptr CNumBytes
len Ptr CDestructor
c_SQLITE_TRANSIENT

bindZeroBlob :: Statement -> ParamIndex -> Int -> IO (Either Error ())
bindZeroBlob :: Statement -> ParamIndex -> Int -> IO (Either Error ())
bindZeroBlob (Statement Ptr CStatement
stmt) ParamIndex
idx Int
len =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Ptr CStatement -> CParamIndex -> CInt -> IO CError
c_sqlite3_bind_zeroblob Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

bindNull :: Statement -> ParamIndex -> IO (Either Error ())
bindNull :: Statement -> ParamIndex -> IO (Either Error ())
bindNull (Statement Ptr CStatement
stmt) ParamIndex
idx =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> CParamIndex -> IO CError
c_sqlite3_bind_null Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx)

columnType :: Statement -> ColumnIndex -> IO ColumnType
columnType :: Statement -> ColumnIndex -> IO ColumnType
columnType (Statement Ptr CStatement
stmt) ColumnIndex
idx =
    CColumnType -> ColumnType
decodeColumnType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> CColumnIndex -> IO CColumnType
c_sqlite3_column_type Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx)

columnInt64 :: Statement -> ColumnIndex -> IO Int64
columnInt64 :: Statement -> ColumnIndex -> IO Int64
columnInt64 (Statement Ptr CStatement
stmt) ColumnIndex
idx =
    Ptr CStatement -> CColumnIndex -> IO Int64
c_sqlite3_column_int64 Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx)

columnDouble :: Statement -> ColumnIndex -> IO Double
columnDouble :: Statement -> ColumnIndex -> IO Double
columnDouble (Statement Ptr CStatement
stmt) ColumnIndex
idx =
    Ptr CStatement -> CColumnIndex -> IO Double
c_sqlite3_column_double Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx)

columnText :: Statement -> ColumnIndex -> IO Utf8
columnText :: Statement -> ColumnIndex -> IO Utf8
columnText (Statement Ptr CStatement
stmt) ColumnIndex
idx = do
    Ptr CChar
ptr <- Ptr CStatement -> CColumnIndex -> IO (Ptr CChar)
c_sqlite3_column_text Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx)
    CNumBytes
len <- Ptr CStatement -> CColumnIndex -> IO CNumBytes
c_sqlite3_column_bytes Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx)
    ByteString -> Utf8
Utf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> CNumBytes -> IO ByteString
packCStringLen Ptr CChar
ptr CNumBytes
len

columnBlob :: Statement -> ColumnIndex -> IO ByteString
columnBlob :: Statement -> ColumnIndex -> IO ByteString
columnBlob (Statement Ptr CStatement
stmt) ColumnIndex
idx = do
    Ptr CChar
ptr <- forall a. Ptr CStatement -> CColumnIndex -> IO (Ptr a)
c_sqlite3_column_blob Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx)
    CNumBytes
len <- Ptr CStatement -> CColumnIndex -> IO CNumBytes
c_sqlite3_column_bytes Ptr CStatement
stmt (forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnIndex
idx)
    Ptr CChar -> CNumBytes -> IO ByteString
packCStringLen Ptr CChar
ptr CNumBytes
len

-- | <https://www.sqlite.org/c3ref/last_insert_rowid.html>
lastInsertRowId :: Database -> IO Int64
lastInsertRowId :: Database -> IO Int64
lastInsertRowId (Database Ptr CDatabase
db) =
    Ptr CDatabase -> IO Int64
c_sqlite3_last_insert_rowid Ptr CDatabase
db

-- | <https://www.sqlite.org/c3ref/changes.html>
--
-- Return the number of rows that were changed, inserted, or deleted
-- by the most recent @INSERT@, @DELETE@, or @UPDATE@ statement.
changes :: Database -> IO Int
changes :: Database -> IO Int
changes (Database Ptr CDatabase
db) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDatabase -> IO CInt
c_sqlite3_changes Ptr CDatabase
db

-- | <https://www.sqlite.org/c3ref/total_changes.html>
--
-- Return the total number of row changes caused by @INSERT@, @DELETE@,
-- or @UPDATE@ statements since the 'Database' was opened.
totalChanges :: Database -> IO Int
totalChanges :: Database -> IO Int
totalChanges (Database Ptr CDatabase
db) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDatabase -> IO CInt
c_sqlite3_total_changes Ptr CDatabase
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 :: FunPtr (CFuncDestroy ())
destroyCFuncPtrs = forall a. IO a -> a
IOU.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. CFuncDestroy a -> IO (FunPtr (CFuncDestroy a))
mkCFuncDestroy CFuncDestroy ()
destroy
  where
    destroy :: CFuncDestroy ()
destroy Ptr ()
p = do
        let p' :: StablePtr a
p' = forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
p
        CFuncPtrs FunPtr CFunc
p1 FunPtr CFunc
p2 FunPtr CFuncFinal
p3 <- forall a. StablePtr a -> IO a
deRefStablePtr forall {a}. StablePtr a
p'
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr CFunc
p1 forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$ forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CFunc
p1
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr CFunc
p2 forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$ forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CFunc
p2
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr CFuncFinal
p3 forall a. Eq a => a -> a -> Bool
== forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$ forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CFuncFinal
p3
        forall a. StablePtr a -> IO ()
freeStablePtr forall {a}. StablePtr a
p'
{-# NOINLINE destroyCFuncPtrs #-}

-- | <https://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
-> Utf8
-> Maybe ArgCount
-> Bool
-> (FuncContext -> FuncArgs -> IO ())
-> IO (Either Error ())
createFunction (Database Ptr CDatabase
db) (Utf8 ByteString
name) Maybe ArgCount
nArgs Bool
isDet FuncContext -> FuncArgs -> IO ()
fun = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
    FunPtr CFunc
funPtr <- CFunc -> IO (FunPtr CFunc)
mkCFunc CFunc
fun'
    StablePtr CFuncPtrs
u <- forall a. a -> IO (StablePtr a)
newStablePtr forall a b. (a -> b) -> a -> b
$ FunPtr CFunc -> FunPtr CFunc -> FunPtr CFuncFinal -> CFuncPtrs
CFuncPtrs FunPtr CFunc
funPtr forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namePtr ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall a.
Ptr CDatabase
-> Ptr CChar
-> CArgCount
-> CInt
-> Ptr a
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_function_v2
                Ptr CDatabase
db Ptr CChar
namePtr (Maybe ArgCount -> CArgCount
maybeArgCount Maybe ArgCount
nArgs) CInt
flags (forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr CFuncPtrs
u)
                FunPtr CFunc
funPtr forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr FunPtr (CFuncDestroy ())
destroyCFuncPtrs
  where
    flags :: CInt
flags = if Bool
isDet then CInt
c_SQLITE_DETERMINISTIC else CInt
0
    fun' :: CFunc
fun' Ptr CContext
ctx CArgCount
nArgs' Ptr (Ptr CValue)
cvals =
        Ptr CContext -> IO () -> IO ()
catchAsResultError Ptr CContext
ctx forall a b. (a -> b) -> a -> b
$
            FuncContext -> FuncArgs -> IO ()
fun (Ptr CContext -> FuncContext
FuncContext Ptr CContext
ctx) (CArgCount -> Ptr (Ptr CValue) -> FuncArgs
FuncArgs CArgCount
nArgs' Ptr (Ptr CValue)
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 :: forall a.
Database
-> Utf8
-> Maybe ArgCount
-> a
-> (FuncContext -> FuncArgs -> a -> IO a)
-> (FuncContext -> a -> IO ())
-> IO (Either Error ())
createAggregate (Database Ptr CDatabase
db) (Utf8 ByteString
name) Maybe ArgCount
nArgs a
initSt FuncContext -> FuncArgs -> a -> IO a
xStep FuncContext -> a -> IO ()
xFinal = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
    FunPtr CFunc
stepPtr <- CFunc -> IO (FunPtr CFunc)
mkCFunc CFunc
xStep'
    FunPtr CFuncFinal
finalPtr <- CFuncFinal -> IO (FunPtr CFuncFinal)
mkCFuncFinal CFuncFinal
xFinal'
    StablePtr CFuncPtrs
u <- forall a. a -> IO (StablePtr a)
newStablePtr forall a b. (a -> b) -> a -> b
$ FunPtr CFunc -> FunPtr CFunc -> FunPtr CFuncFinal -> CFuncPtrs
CFuncPtrs forall a. FunPtr a
nullFunPtr FunPtr CFunc
stepPtr FunPtr CFuncFinal
finalPtr
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namePtr ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall a.
Ptr CDatabase
-> Ptr CChar
-> CArgCount
-> CInt
-> Ptr a
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_function_v2
                Ptr CDatabase
db Ptr CChar
namePtr (Maybe ArgCount -> CArgCount
maybeArgCount Maybe ArgCount
nArgs) CInt
0 (forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr CFuncPtrs
u)
                forall a. FunPtr a
nullFunPtr FunPtr CFunc
stepPtr FunPtr CFuncFinal
finalPtr FunPtr (CFuncDestroy ())
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' :: CFunc
xStep' Ptr CContext
ctx CArgCount
nArgs' Ptr (Ptr CValue)
cvals =
        Ptr CContext -> IO () -> IO ()
catchAsResultError Ptr CContext
ctx forall a b. (a -> b) -> a -> b
$ do
            Ptr (StablePtr (IORef a))
aggCtx <- forall {a}. Ptr CContext -> IO (Ptr a)
getAggregateContext Ptr CContext
ctx
            StablePtr (IORef a)
aggStPtr <- forall a. Storable a => Ptr a -> IO a
peek Ptr (StablePtr (IORef a))
aggCtx
            IORef a
aggStRef <-
                if forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr (IORef a)
aggStPtr forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr then
                    forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (IORef a)
aggStPtr
                else do
                    IORef a
aggStRef <- forall a. a -> IO (IORef a)
newIORef a
initSt
                    StablePtr (IORef a)
aggStPtr' <- forall a. a -> IO (StablePtr a)
newStablePtr IORef a
aggStRef
                    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (StablePtr (IORef a))
aggCtx StablePtr (IORef a)
aggStPtr'
                    forall (m :: * -> *) a. Monad m => a -> m a
return IORef a
aggStRef
            a
aggSt <- forall a. IORef a -> IO a
readIORef IORef a
aggStRef
            a
aggSt' <- FuncContext -> FuncArgs -> a -> IO a
xStep (Ptr CContext -> FuncContext
FuncContext Ptr CContext
ctx) (CArgCount -> Ptr (Ptr CValue) -> FuncArgs
FuncArgs CArgCount
nArgs' Ptr (Ptr CValue)
cvals) a
aggSt
            forall a. IORef a -> a -> IO ()
writeIORef IORef a
aggStRef a
aggSt'
    xFinal' :: CFuncFinal
xFinal' Ptr CContext
ctx = do
        Ptr (StablePtr (IORef a))
aggCtx <- forall {a}. Ptr CContext -> IO (Ptr a)
getAggregateContext Ptr CContext
ctx
        StablePtr (IORef a)
aggStPtr <- forall a. Storable a => Ptr a -> IO a
peek Ptr (StablePtr (IORef a))
aggCtx
        if forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr (IORef a)
aggStPtr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then
            Ptr CContext -> IO () -> IO ()
catchAsResultError Ptr CContext
ctx forall a b. (a -> b) -> a -> b
$
                FuncContext -> a -> IO ()
xFinal (Ptr CContext -> FuncContext
FuncContext Ptr CContext
ctx) a
initSt
        else do
            Ptr CContext -> IO () -> IO ()
catchAsResultError Ptr CContext
ctx forall a b. (a -> b) -> a -> b
$ do
                IORef a
aggStRef <- forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (IORef a)
aggStPtr
                a
aggSt <- forall a. IORef a -> IO a
readIORef IORef a
aggStRef
                FuncContext -> a -> IO ()
xFinal (Ptr CContext -> FuncContext
FuncContext Ptr CContext
ctx) a
aggSt
            forall a. StablePtr a -> IO ()
freeStablePtr StablePtr (IORef a)
aggStPtr
    getAggregateContext :: Ptr CContext -> IO (Ptr a)
getAggregateContext Ptr CContext
ctx =
        forall a. Ptr CContext -> CNumBytes -> IO (Ptr a)
c_sqlite3_aggregate_context Ptr CContext
ctx CNumBytes
stPtrSize
    stPtrSize :: CNumBytes
stPtrSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: StablePtr ())

-- call c_sqlite3_result_error in the event of an error
catchAsResultError :: Ptr CContext -> IO () -> IO ()
catchAsResultError :: Ptr CContext -> IO () -> IO ()
catchAsResultError Ptr CContext
ctx IO ()
action = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch IO ()
action forall a b. (a -> b) -> a -> b
$ \SomeException
exn -> do
    let msg :: String
msg = forall a. Show a => a -> String
show (SomeException
exn :: SomeException)
    forall a. String -> (CStringLen -> IO a) -> IO a
withCAStringLen String
msg forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
        Ptr CContext -> Ptr CChar -> CNumBytes -> IO ()
c_sqlite3_result_error Ptr CContext
ctx Ptr CChar
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

-- | Delete an SQL function (scalar or aggregate).
deleteFunction :: Database -> Utf8 -> Maybe ArgCount -> IO (Either Error ())
deleteFunction :: Database -> Utf8 -> Maybe ArgCount -> IO (Either Error ())
deleteFunction (Database Ptr CDatabase
db) (Utf8 ByteString
name) Maybe ArgCount
nArgs =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namePtr ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall a.
Ptr CDatabase
-> Ptr CChar
-> CArgCount
-> CInt
-> Ptr a
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_function_v2
                Ptr CDatabase
db Ptr CChar
namePtr (Maybe ArgCount -> CArgCount
maybeArgCount Maybe ArgCount
nArgs) CInt
0 forall a. Ptr a
nullPtr
                forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr

maybeArgCount :: Maybe ArgCount -> CArgCount
maybeArgCount :: Maybe ArgCount -> CArgCount
maybeArgCount (Just ArgCount
n) = forall public ffi. FFIType public ffi => public -> ffi
toFFI ArgCount
n
maybeArgCount Maybe ArgCount
Nothing  = -CArgCount
1

funcArgCount :: FuncArgs -> ArgCount
funcArgCount :: FuncArgs -> ArgCount
funcArgCount (FuncArgs CArgCount
nArgs Ptr (Ptr CValue)
_) = forall a b. (Integral a, Num b) => a -> b
fromIntegral CArgCount
nArgs

funcArgType :: FuncArgs -> ArgIndex -> IO ColumnType
funcArgType :: FuncArgs -> ArgCount -> IO ColumnType
funcArgType =
    forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg ColumnType
NullColumn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CColumnType -> ColumnType
decodeColumnType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CValue -> IO CColumnType
c_sqlite3_value_type)

funcArgInt64 :: FuncArgs -> ArgIndex -> IO Int64
funcArgInt64 :: FuncArgs -> ArgCount -> IO Int64
funcArgInt64 = forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg Int64
0 Ptr CValue -> IO Int64
c_sqlite3_value_int64

funcArgDouble :: FuncArgs -> ArgIndex -> IO Double
funcArgDouble :: FuncArgs -> ArgCount -> IO Double
funcArgDouble = forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg Double
0 Ptr CValue -> IO Double
c_sqlite3_value_double

funcArgText :: FuncArgs -> ArgIndex -> IO Utf8
funcArgText :: FuncArgs -> ArgCount -> IO Utf8
funcArgText = forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ \Ptr CValue
cval -> do
    Ptr CChar
ptr <- Ptr CValue -> IO (Ptr CChar)
c_sqlite3_value_text Ptr CValue
cval
    CNumBytes
len <- Ptr CValue -> IO CNumBytes
c_sqlite3_value_bytes Ptr CValue
cval
    ByteString -> Utf8
Utf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> CNumBytes -> IO ByteString
packCStringLen Ptr CChar
ptr CNumBytes
len

funcArgBlob :: FuncArgs -> ArgIndex -> IO ByteString
funcArgBlob :: FuncArgs -> ArgCount -> IO ByteString
funcArgBlob  = forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ \Ptr CValue
cval -> do
    Ptr CChar
ptr <- forall a. Ptr CValue -> IO (Ptr a)
c_sqlite3_value_blob Ptr CValue
cval
    CNumBytes
len <- Ptr CValue -> IO CNumBytes
c_sqlite3_value_bytes Ptr CValue
cval
    Ptr CChar -> CNumBytes -> IO ByteString
packCStringLen Ptr CChar
ptr CNumBytes
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 :: forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg a
defVal Ptr CValue -> IO a
extract (FuncArgs CArgCount
nArgs Ptr (Ptr CValue)
p) ArgCount
idx
    | ArgCount
0 forall a. Ord a => a -> a -> Bool
<= ArgCount
idx Bool -> Bool -> Bool
&& ArgCount
idx forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral CArgCount
nArgs = do
        Ptr CValue
cval <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr CValue)
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral ArgCount
idx)
        Ptr CValue -> IO a
extract Ptr CValue
cval
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return a
defVal

funcResultInt64 :: FuncContext -> Int64 -> IO ()
funcResultInt64 :: FuncContext -> Int64 -> IO ()
funcResultInt64 (FuncContext Ptr CContext
ctx) Int64
value =
    Ptr CContext -> Int64 -> IO ()
c_sqlite3_result_int64 Ptr CContext
ctx Int64
value

funcResultDouble :: FuncContext -> Double -> IO ()
funcResultDouble :: FuncContext -> Double -> IO ()
funcResultDouble (FuncContext Ptr CContext
ctx) Double
value =
    Ptr CContext -> Double -> IO ()
c_sqlite3_result_double Ptr CContext
ctx Double
value

funcResultText :: FuncContext -> Utf8 -> IO ()
funcResultText :: FuncContext -> Utf8 -> IO ()
funcResultText (FuncContext Ptr CContext
ctx) (Utf8 ByteString
value) =
    forall a. ByteString -> (Ptr CChar -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr CNumBytes
len ->
        Ptr CContext -> Ptr CChar -> CNumBytes -> Ptr CDestructor -> IO ()
c_sqlite3_result_text Ptr CContext
ctx Ptr CChar
ptr CNumBytes
len Ptr CDestructor
c_SQLITE_TRANSIENT

funcResultBlob :: FuncContext -> ByteString -> IO ()
funcResultBlob :: FuncContext -> ByteString -> IO ()
funcResultBlob (FuncContext Ptr CContext
ctx) ByteString
value =
    forall a. ByteString -> (Ptr CChar -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr CNumBytes
len ->
        forall a.
Ptr CContext -> Ptr a -> CNumBytes -> Ptr CDestructor -> IO ()
c_sqlite3_result_blob Ptr CContext
ctx Ptr CChar
ptr CNumBytes
len Ptr CDestructor
c_SQLITE_TRANSIENT

funcResultZeroBlob :: FuncContext -> Int -> IO ()
funcResultZeroBlob :: FuncContext -> Int -> IO ()
funcResultZeroBlob (FuncContext Ptr CContext
ctx) Int
len =
    Ptr CContext -> CNumBytes -> IO ()
c_sqlite3_result_zeroblob Ptr CContext
ctx (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

funcResultNull :: FuncContext -> IO ()
funcResultNull :: FuncContext -> IO ()
funcResultNull (FuncContext Ptr CContext
ctx) =
    CFuncFinal
c_sqlite3_result_null Ptr CContext
ctx

-- | <https://www.sqlite.org/c3ref/context_db_handle.html>
getFuncContextDatabase :: FuncContext -> IO Database
getFuncContextDatabase :: FuncContext -> IO Database
getFuncContextDatabase (FuncContext Ptr CContext
ctx) = do
    Ptr CDatabase
db <- Ptr CContext -> IO (Ptr CDatabase)
c_sqlite3_context_db_handle Ptr CContext
ctx
    if Ptr CDatabase
db forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
        then forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"sqlite3_context_db_handle(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Ptr CContext
ctx forall a. [a] -> [a] -> [a]
++ String
") returned NULL"
        else forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CDatabase -> Database
Database Ptr CDatabase
db)

-- | Deallocate the function pointer to the comparison function used to
-- implement a custom collation
destroyCCompare :: CFuncDestroy ()
destroyCCompare :: CFuncDestroy ()
destroyCCompare Ptr ()
ptr = forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr (CCompare ())
ptr'
  where
    ptr' :: FunPtr (CCompare ())
ptr' = forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr ()
ptr :: FunPtr (CCompare ())

-- | This is called by sqlite so we create one global FunPtr to pass to sqlite
destroyCComparePtr :: FunPtr (CFuncDestroy ())
destroyCComparePtr :: FunPtr (CFuncDestroy ())
destroyCComparePtr = forall a. IO a -> a
IOU.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. CFuncDestroy a -> IO (FunPtr (CFuncDestroy a))
mkCFuncDestroy CFuncDestroy ()
destroyCCompare
{-# NOINLINE destroyCComparePtr #-}

-- | <https://www.sqlite.org/c3ref/create_collation.html>
createCollation
    :: Database
    -> Utf8                       -- ^ Name of the collation.
    -> (Utf8 -> Utf8 -> Ordering) -- ^ Comparison function.
    -> IO (Either Error ())
createCollation :: Database
-> Utf8 -> (Utf8 -> Utf8 -> Ordering) -> IO (Either Error ())
createCollation (Database Ptr CDatabase
db) (Utf8 ByteString
name) Utf8 -> Utf8 -> Ordering
cmp = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
    FunPtr (CCompare ())
cmpPtr <- forall a. CCompare a -> IO (FunPtr (CCompare a))
mkCCompare forall {a} {p}.
Num a =>
p -> CNumBytes -> Ptr CChar -> CNumBytes -> Ptr CChar -> IO a
cmp'
    let u :: Ptr b
u = forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (CCompare ())
cmpPtr
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namePtr ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            CError
r <- forall a.
Ptr CDatabase
-> Ptr CChar
-> CInt
-> Ptr a
-> FunPtr (CCompare a)
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_collation_v2
                Ptr CDatabase
db Ptr CChar
namePtr CInt
c_SQLITE_UTF8 forall a. Ptr a
u FunPtr (CCompare ())
cmpPtr FunPtr (CFuncDestroy ())
destroyCComparePtr
            -- sqlite does not call the destructor for us in case of an
            -- error
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CError
r forall a. Eq a => a -> a -> Bool
== CInt -> CError
CError CInt
0) forall a b. (a -> b) -> a -> b
$
                CFuncDestroy ()
destroyCCompare forall a b. (a -> b) -> a -> b
$ forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (CCompare ())
cmpPtr
            forall (m :: * -> *) a. Monad m => a -> m a
return CError
r
  where
    cmp' :: p -> CNumBytes -> Ptr CChar -> CNumBytes -> Ptr CChar -> IO a
cmp' p
_ CNumBytes
len1 Ptr CChar
ptr1 CNumBytes
len2 Ptr CChar
ptr2 = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall {m :: * -> *} {a}. (Monad m, Num a) => SomeException -> m a
exnHandler forall a b. (a -> b) -> a -> b
$ do
        Utf8
s1 <- ByteString -> Utf8
Utf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> CNumBytes -> IO ByteString
packCStringLen Ptr CChar
ptr1 CNumBytes
len1
        Utf8
s2 <- ByteString -> Utf8
Utf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> CNumBytes -> IO ByteString
packCStringLen Ptr CChar
ptr2 CNumBytes
len2
        let c :: Ordering
c = Utf8 -> Utf8 -> Ordering
cmp Utf8
s1 Utf8
s2
        forall a. a -> IO a
evaluate (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Ordering
c forall a. Num a => a -> a -> a
- Int
1)
    exnHandler :: SomeException -> m a
exnHandler (SomeException
_ :: SomeException) = forall (m :: * -> *) a. Monad m => a -> m a
return (-a
1)

-- | Delete a collation.
deleteCollation :: Database -> Utf8 -> IO (Either Error ())
deleteCollation :: Database -> Utf8 -> IO (Either Error ())
deleteCollation (Database Ptr CDatabase
db) (Utf8 ByteString
name) =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
name forall a b. (a -> b) -> a -> b
$ \Ptr CChar
namePtr ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall a.
Ptr CDatabase
-> Ptr CChar
-> CInt
-> Ptr a
-> FunPtr (CCompare a)
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_collation_v2
                Ptr CDatabase
db Ptr CChar
namePtr CInt
c_SQLITE_UTF8 forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr forall a. FunPtr a
nullFunPtr

-- | <https://www.sqlite.org/c3ref/enable_load_extension.html>
--
-- Enable or disable extension loading.
setLoadExtensionEnabled :: Database -> Bool -> IO (Either Error ())
setLoadExtensionEnabled :: Database -> Bool -> IO (Either Error ())
setLoadExtensionEnabled (Database Ptr CDatabase
db) Bool
enabled =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDatabase -> Bool -> IO CError
c_sqlite3_enable_load_extension Ptr CDatabase
db Bool
enabled

-- | <https://www.sqlite.org/c3ref/blob_open.html>
--
-- Open a blob for incremental I/O.
blobOpen
    :: Database
    -> Utf8   -- ^ The symbolic name of the database (e.g. "main").
    -> Utf8   -- ^ The table name.
    -> Utf8   -- ^ The column name.
    -> Int64  -- ^ The @ROWID@ of the row.
    -> Bool   -- ^ Open the blob for read-write.
    -> IO (Either Error Blob)
blobOpen :: Database
-> Utf8 -> Utf8 -> Utf8 -> Int64 -> Bool -> IO (Either Error Blob)
blobOpen (Database Ptr CDatabase
db) (Utf8 ByteString
zDb) (Utf8 ByteString
zTable) (Utf8 ByteString
zColumn) Int64
rowid Bool
rw =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
zDb forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptrDb ->
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
zTable forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptrTable ->
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
zColumn forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptrColumn ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CBlob)
ptrBlob ->
        Ptr CDatabase
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Int64
-> CInt
-> Ptr (Ptr CBlob)
-> IO CError
c_sqlite3_blob_open Ptr CDatabase
db Ptr CChar
ptrDb Ptr CChar
ptrTable Ptr CChar
ptrColumn Int64
rowid CInt
flags Ptr (Ptr CBlob)
ptrBlob
            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Monad m =>
m a -> CError -> m (Either Error a)
toResultM (Database -> Ptr CBlob -> Blob
Blob (Ptr CDatabase -> Database
Database Ptr CDatabase
db) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CBlob)
ptrBlob)
  where
    flags :: CInt
flags = if Bool
rw then CInt
1 else CInt
0

-- | <https://www.sqlite.org/c3ref/blob_close.html>
blobClose :: Blob -> IO (Either Error ())
blobClose :: Blob -> IO (Either Error ())
blobClose (Blob Database
_ Ptr CBlob
blob) =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBlob -> IO CError
c_sqlite3_blob_close Ptr CBlob
blob

-- | <https://www.sqlite.org/c3ref/blob_reopen.html>
blobReopen
    :: Blob
    -> Int64 -- ^ The @ROWID@ of the row.
    -> IO (Either Error ())
blobReopen :: Blob -> Int64 -> IO (Either Error ())
blobReopen (Blob Database
_ Ptr CBlob
blob) Int64
rowid =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBlob -> Int64 -> IO CError
c_sqlite3_blob_reopen Ptr CBlob
blob Int64
rowid

-- | <https://www.sqlite.org/c3ref/blob_bytes.html>
blobBytes :: Blob -> IO Int
blobBytes :: Blob -> IO Int
blobBytes (Blob Database
_ Ptr CBlob
blob) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBlob -> IO CInt
c_sqlite3_blob_bytes Ptr CBlob
blob

-- | <https://www.sqlite.org/c3ref/blob_read.html>
blobRead
    :: Blob
    -> Int  -- ^ Number of bytes to read.
    -> Int  -- ^ Offset within the blob.
    -> IO (Either Error ByteString)
blobRead :: Blob -> Int -> Int -> IO (Either Error ByteString)
blobRead Blob
blob Int
len Int
offset = do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
BSI.mallocByteString Int
len
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\()
_ -> ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
fp Int
0 Int
len) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> forall a. Blob -> Ptr a -> Int -> Int -> IO (Either Error ())
blobReadBuf Blob
blob Ptr Word8
p Int
len Int
offset)

blobReadBuf :: Blob -> Ptr a -> Int -> Int -> IO (Either Error ())
blobReadBuf :: forall a. Blob -> Ptr a -> Int -> Int -> IO (Either Error ())
blobReadBuf (Blob Database
_ Ptr CBlob
blob) Ptr a
buf Int
len Int
offset =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall a. Ptr CBlob -> Ptr a -> CInt -> CInt -> IO CError
c_sqlite3_blob_read Ptr CBlob
blob Ptr a
buf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset)

-- | <https://www.sqlite.org/c3ref/blob_write.html>
blobWrite
    :: Blob
    -> ByteString
    -> Int -- ^ Offset within the blob.
    -> IO (Either Error ())
blobWrite :: Blob -> ByteString -> Int -> IO (Either Error ())
blobWrite (Blob Database
_ Ptr CBlob
blob) ByteString
bs Int
offset =
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buf, Int
len) ->
        forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            forall a. Ptr CBlob -> Ptr a -> CInt -> CInt -> IO CError
c_sqlite3_blob_write Ptr CBlob
blob Ptr CChar
buf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset)

-- | <https://www.sqlite.org/c3ref/backup_finish.html#sqlite3backupinit>
backupInit
    :: Database  -- ^ Destination database handle.
    -> Utf8      -- ^ Destination database name.
    -> Database  -- ^ Source database handle.
    -> Utf8      -- ^ Source database name.
    -> IO (Either Error Backup)
backupInit :: Database -> Utf8 -> Database -> Utf8 -> IO (Either Error Backup)
backupInit (Database Ptr CDatabase
dstDb) (Utf8 ByteString
dstName) (Database Ptr CDatabase
srcDb) (Utf8 ByteString
srcName) =
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
dstName forall a b. (a -> b) -> a -> b
$ \Ptr CChar
dstName' ->
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
srcName forall a b. (a -> b) -> a -> b
$ \Ptr CChar
srcName' -> do
        Ptr CBackup
r <- Ptr CDatabase
-> Ptr CChar -> Ptr CDatabase -> Ptr CChar -> IO (Ptr CBackup)
c_sqlite3_backup_init Ptr CDatabase
dstDb Ptr CChar
dstName' Ptr CDatabase
srcDb Ptr CChar
srcName'
        if Ptr CBackup
r forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
            then forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> IO Error
errcode (Ptr CDatabase -> Database
Database Ptr CDatabase
dstDb)
            else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (Database -> Ptr CBackup -> Backup
Backup (Ptr CDatabase -> Database
Database Ptr CDatabase
dstDb) Ptr CBackup
r))

-- | <https://www.sqlite.org/c3ref/backup_finish.html#sqlite3backupfinish>
backupFinish :: Backup -> IO (Either Error ())
backupFinish :: Backup -> IO (Either Error ())
backupFinish (Backup Database
_ Ptr CBackup
backup) =
    forall a. a -> CError -> Either Error a
toResult () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Ptr CBackup -> IO CError
c_sqlite3_backup_finish Ptr CBackup
backup

-- | <https://www.sqlite.org/c3ref/backup_finish.html#sqlite3backupstep>
backupStep
    :: Backup
    -> Int    -- ^ Number of pages to copy; if negative, all remaining source pages are copied.
    -> IO (Either Error BackupStepResult)
backupStep :: Backup -> Int -> IO (Either Error BackupStepResult)
backupStep (Backup Database
_ Ptr CBackup
backup) Int
pages =
    CError -> Either Error BackupStepResult
toBackupStepResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Ptr CBackup -> CInt -> IO CError
c_sqlite3_backup_step Ptr CBackup
backup (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pages)

-- | <https://www.sqlite.org/c3ref/backup_finish.html#sqlite3backupremaining>
backupRemaining :: Backup -> IO Int
backupRemaining :: Backup -> IO Int
backupRemaining (Backup Database
_ Ptr CBackup
backup) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBackup -> IO CInt
c_sqlite3_backup_remaining Ptr CBackup
backup

-- | <https://www.sqlite.org/c3ref/backup_finish.html#sqlite3backuppagecount>
backupPagecount :: Backup -> IO Int
backupPagecount :: Backup -> IO Int
backupPagecount (Backup Database
_ Ptr CBackup
backup) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBackup -> IO CInt
c_sqlite3_backup_pagecount Ptr CBackup
backup