{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# 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,
    close,
    errcode,
    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

#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup (Semigroup)
#endif

newtype Database = Database (Ptr CDatabase)
    deriving (Database -> Database -> Bool
(Database -> Database -> Bool)
-> (Database -> Database -> Bool) -> Eq Database
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
(Int -> Database -> ShowS)
-> (Database -> String) -> ([Database] -> ShowS) -> Show Database
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
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
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
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
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
(StepResult -> StepResult -> Bool)
-> (StepResult -> StepResult -> Bool) -> Eq StepResult
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
(Int -> StepResult -> ShowS)
-> (StepResult -> String)
-> ([StepResult] -> ShowS)
-> Show StepResult
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
(BackupStepResult -> BackupStepResult -> Bool)
-> (BackupStepResult -> BackupStepResult -> Bool)
-> Eq BackupStepResult
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
(Int -> BackupStepResult -> ShowS)
-> (BackupStepResult -> String)
-> ([BackupStepResult] -> ShowS)
-> Show BackupStepResult
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
(Utf8 -> Utf8 -> Bool) -> (Utf8 -> Utf8 -> Bool) -> Eq Utf8
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
Eq Utf8
-> (Utf8 -> Utf8 -> Ordering)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Utf8)
-> (Utf8 -> Utf8 -> Utf8)
-> Ord 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
$cp1Ord :: Eq Utf8
Ord, b -> Utf8 -> Utf8
NonEmpty Utf8 -> Utf8
Utf8 -> Utf8 -> Utf8
(Utf8 -> Utf8 -> Utf8)
-> (NonEmpty Utf8 -> Utf8)
-> (forall b. Integral b => b -> Utf8 -> Utf8)
-> Semigroup 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 :: 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
Semigroup Utf8
-> Utf8
-> (Utf8 -> Utf8 -> Utf8)
-> ([Utf8] -> Utf8)
-> Monoid 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
$cp1Monoid :: Semigroup Utf8
Monoid)

instance Show Utf8 where
    show :: Utf8 -> String
show (Utf8 ByteString
s) = (Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (ByteString -> Text) -> ByteString -> String
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 (ByteString -> Utf8) -> (String -> ByteString) -> String -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

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

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

packUtf8Array :: IO a -> (Utf8 -> IO a) -> Int -> Ptr CString -> IO [a]
packUtf8Array :: IO a -> (Utf8 -> IO a) -> Int -> Ptr CString -> IO [a]
packUtf8Array IO a
onNull Utf8 -> IO a
onUtf8 Int
count Ptr CString
base =
    Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr CString
base IO [CString] -> ([CString] -> IO [a]) -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO a) -> [CString] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IO (IO a) -> IO a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO a) -> IO a) -> (CString -> IO (IO a)) -> CString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> (Utf8 -> IO a) -> CString -> IO (IO a)
forall a. a -> (Utf8 -> a) -> CString -> 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 :: ByteString -> (CString -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
bs CString -> CNumBytes -> IO a
cb
    | ByteString -> Bool
BS.null ByteString
bs = CString -> CNumBytes -> IO a
cb (IntPtr -> CString
forall a. IntPtr -> Ptr a
intPtrToPtr IntPtr
1) CNumBytes
0
    | Bool
otherwise  = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
                       CString -> CNumBytes -> IO a
cb CString
ptr (Int -> CNumBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

wrapNullablePtr :: (Ptr a -> b) -> Ptr a -> Maybe b
wrapNullablePtr :: (Ptr a -> b) -> Ptr a -> Maybe b
wrapNullablePtr Ptr a -> b
f Ptr a
ptr | Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr = Maybe b
forall a. Maybe a
Nothing
                      | Bool
otherwise      = b -> Maybe b
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 :: a -> CError -> Either Error a
toResult a
a (CError CInt
0) = a -> Either Error a
forall a b. b -> Either a b
Right a
a
toResult a
_ CError
code       = Error -> Either Error a
forall a b. a -> Either a b
Left (Error -> Either Error a) -> Error -> Either Error a
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 :: m a -> CError -> m (Either Error a)
toResultM m a
m (CError CInt
0) = a -> Either Error a
forall a b. b -> Either a b
Right (a -> Either Error a) -> m a -> m (Either Error a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m
toResultM m a
_ CError
code       = Either Error a -> m (Either Error a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error a -> m (Either Error a))
-> Either Error a -> m (Either Error a)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error a
forall a b. a -> Either a b
Left (Error -> Either Error a) -> Error -> Either Error a
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  -> StepResult -> Either Error StepResult
forall a b. b -> Either a b
Right StepResult
Row
        Error
ErrorDone -> StepResult -> Either Error StepResult
forall a b. b -> Either a b
Right StepResult
Done
        Error
err       -> Error -> Either Error StepResult
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   -> BackupStepResult -> Either Error BackupStepResult
forall a b. b -> Either a b
Right BackupStepResult
BackupOK
        Error
ErrorDone -> BackupStepResult -> Either Error BackupStepResult
forall a b. b -> Either a b
Right BackupStepResult
BackupDone
        Error
err       -> Error -> Either Error BackupStepResult
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
(FuncContext -> FuncContext -> Bool)
-> (FuncContext -> FuncContext -> Bool) -> Eq FuncContext
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
(Int -> FuncContext -> ShowS)
-> (FuncContext -> String)
-> ([FuncContext] -> ShowS)
-> Show FuncContext
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
(Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
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
(Int -> Blob -> ShowS)
-> (Blob -> String) -> ([Blob] -> ShowS) -> Show Blob
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
(Backup -> Backup -> Bool)
-> (Backup -> Backup -> Bool) -> Eq Backup
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
(Int -> Backup -> ShowS)
-> (Backup -> String) -> ([Backup] -> ShowS) -> Show Backup
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) =
    ByteString
-> (CString -> IO (Either (Error, Utf8) Database))
-> IO (Either (Error, Utf8) Database)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
path ((CString -> IO (Either (Error, Utf8) Database))
 -> IO (Either (Error, Utf8) Database))
-> (CString -> IO (Either (Error, Utf8) Database))
-> IO (Either (Error, Utf8) Database)
forall a b. (a -> b) -> a -> b
$ \CString
path' ->
    (Ptr (Ptr CDatabase) -> IO (Either (Error, Utf8) Database))
-> IO (Either (Error, Utf8) Database)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CDatabase) -> IO (Either (Error, Utf8) Database))
 -> IO (Either (Error, Utf8) Database))
-> (Ptr (Ptr CDatabase) -> IO (Either (Error, Utf8) Database))
-> IO (Either (Error, Utf8) Database)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CDatabase)
database -> do
        CError
rc <- CString -> Ptr (Ptr CDatabase) -> IO CError
c_sqlite3_open CString
path' Ptr (Ptr CDatabase)
database
        Database
db <- Ptr CDatabase -> Database
Database (Ptr CDatabase -> Database) -> IO (Ptr CDatabase) -> IO Database
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr CDatabase) -> IO (Ptr CDatabase)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CDatabase)
database
            -- sqlite3_open returns a sqlite3 even on failure.
            -- That's where we get a more descriptive error message.
        case () -> CError -> Either Error ()
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.
                Either (Error, Utf8) Database -> IO (Either (Error, Utf8) Database)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Error, Utf8) Database
 -> IO (Either (Error, Utf8) Database))
-> Either (Error, Utf8) Database
-> IO (Either (Error, Utf8) Database)
forall a b. (a -> b) -> a -> b
$ (Error, Utf8) -> Either (Error, Utf8) Database
forall a b. a -> Either a b
Left (Error
err, Utf8
msg)
            Right () ->
                if Database
db Database -> Database -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CDatabase -> Database
Database Ptr CDatabase
forall a. Ptr a
nullPtr
                    then String -> IO (Either (Error, Utf8) Database)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sqlite3_open unexpectedly returned NULL"
                    else Either (Error, Utf8) Database -> IO (Either (Error, Utf8) Database)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Error, Utf8) Database
 -> IO (Either (Error, Utf8) Database))
-> Either (Error, Utf8) Database
-> IO (Either (Error, Utf8) Database)
forall a b. (a -> b) -> a -> b
$ Database -> Either (Error, Utf8) Database
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) =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 (CError -> Error) -> IO CError -> IO Error
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>
errmsg :: Database -> IO Utf8
errmsg :: Database -> IO Utf8
errmsg (Database Ptr CDatabase
db) =
    Ptr CDatabase -> IO CString
c_sqlite3_errmsg Ptr CDatabase
db IO CString -> (CString -> IO Utf8) -> IO Utf8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Utf8 -> (Utf8 -> Utf8) -> CString -> IO Utf8
forall a. a -> (Utf8 -> a) -> CString -> IO a
packUtf8 Utf8
forall a. Monoid a => a
mempty Utf8 -> Utf8
forall a. a -> a
id

withErrorMessagePtr :: (Ptr CString -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr :: (Ptr CString -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr Ptr CString -> IO CError
action =
    (Ptr CString -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Either (Error, Utf8) ()))
 -> IO (Either (Error, Utf8) ()))
-> (Ptr CString -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a b. (a -> b) -> a -> b
$ \Ptr CString
msgPtrOut -> ((forall a. IO a -> IO a) -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (Either (Error, Utf8) ()))
 -> IO (Either (Error, Utf8) ()))
-> ((forall a. IO a -> IO a) -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
        Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
msgPtrOut CString
forall a. Ptr a
nullPtr
        CError
rc <- IO CError -> IO CError
forall a. IO a -> IO a
restore (Ptr CString -> IO CError
action Ptr CString
msgPtrOut)
            IO CError -> IO () -> IO CError
forall a b. IO a -> IO b -> IO a
`onException` (Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
msgPtrOut IO CString -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ()
forall a. Ptr a -> IO ()
c_sqlite3_free)
        case () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () CError
rc of
            Left Error
err -> do
                CString
msgPtr <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
msgPtrOut
                if CString
msgPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
                    then Either (Error, Utf8) () -> IO (Either (Error, Utf8) ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Error, Utf8) -> Either (Error, Utf8) ()
forall a b. a -> Either a b
Left (Error
err, Utf8
forall a. Monoid a => a
mempty))
                    else do
                        CSize
len <- CString -> IO CSize
BSI.c_strlen CString
msgPtr
                        ForeignPtr CChar
fp <- FinalizerPtr CChar -> CString -> IO (ForeignPtr CChar)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CChar
forall a. FunPtr (Ptr a -> IO ())
c_sqlite3_free_p CString
msgPtr
                        let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr CChar
fp) Int
0 (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
                        Either (Error, Utf8) () -> IO (Either (Error, Utf8) ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Error, Utf8) -> Either (Error, Utf8) ()
forall a b. a -> Either a b
Left (Error
err, ByteString -> Utf8
Utf8 ByteString
bs))
            Right () -> Either (Error, Utf8) () -> IO (Either (Error, Utf8) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either (Error, Utf8) ()
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) =
    ByteString
-> (CString -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
sql ((CString -> IO (Either (Error, Utf8) ()))
 -> IO (Either (Error, Utf8) ()))
-> (CString -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a b. (a -> b) -> a -> b
$ \CString
sql' ->
        (Ptr CString -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr (Ptr CDatabase
-> CString
-> FunPtr (CExecCallback Any)
-> Ptr Any
-> Ptr CString
-> IO CError
forall a.
Ptr CDatabase
-> CString
-> FunPtr (CExecCallback a)
-> Ptr a
-> Ptr CString
-> IO CError
c_sqlite3_exec Ptr CDatabase
db CString
sql' FunPtr (CExecCallback Any)
forall a. FunPtr a
nullFunPtr Ptr Any
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 <- Maybe SomeException -> IO (IORef (Maybe SomeException))
forall a. a -> IO (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing :: IO (IORef (Maybe SomeException))
    IORef (Maybe ([Maybe Utf8] -> IO ()))
cbCache <- Maybe ([Maybe Utf8] -> IO ())
-> IO (IORef (Maybe ([Maybe Utf8] -> IO ())))
forall a. a -> IO (IORef a)
newIORef Maybe ([Maybe Utf8] -> IO ())
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 CString -> IO ([Maybe Utf8] -> IO ())
getCallback CColumnIndex
cCount Ptr CString
cNames = do
            Maybe ([Maybe Utf8] -> IO ())
m <- IORef (Maybe ([Maybe Utf8] -> IO ()))
-> IO (Maybe ([Maybe Utf8] -> IO ()))
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 <- IO Utf8 -> (Utf8 -> IO Utf8) -> Int -> Ptr CString -> IO [Utf8]
forall a. IO a -> (Utf8 -> IO a) -> Int -> Ptr CString -> IO [a]
packUtf8Array (String -> IO Utf8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"execWithCallback: NULL column name")
                                           Utf8 -> IO Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return
                                           (CColumnIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CColumnIndex
cCount) Ptr CString
cNames
                    let !cb' :: [Maybe Utf8] -> IO ()
cb' = ExecCallback
cb (CColumnIndex -> ColumnCount
forall public ffi. FFIType public ffi => ffi -> public
fromFFI CColumnIndex
cCount) [Utf8]
names
                    IORef (Maybe ([Maybe Utf8] -> IO ()))
-> Maybe ([Maybe Utf8] -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ([Maybe Utf8] -> IO ()))
cbCache (Maybe ([Maybe Utf8] -> IO ()) -> IO ())
-> Maybe ([Maybe Utf8] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ([Maybe Utf8] -> IO ()) -> Maybe ([Maybe Utf8] -> IO ())
forall a. a -> Maybe a
Just [Maybe Utf8] -> IO ()
cb'
                    ([Maybe Utf8] -> IO ()) -> IO ([Maybe Utf8] -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe Utf8] -> IO ()
cb'
                Just [Maybe Utf8] -> IO ()
cb' -> ([Maybe Utf8] -> IO ()) -> IO ([Maybe Utf8] -> IO ())
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 IO a -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
0) IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
ex -> do
            IORef (Maybe SomeException) -> Maybe SomeException -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe SomeException)
abortReason (Maybe SomeException -> IO ()) -> Maybe SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
ex
            a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
1

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

    ByteString
-> (CString -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
sql ((CString -> IO (Either (Error, Utf8) ()))
 -> IO (Either (Error, Utf8) ()))
-> (CString -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a b. (a -> b) -> a -> b
$ \CString
sql' ->
        IO (FunPtr (CExecCallback Any))
-> (FunPtr (CExecCallback Any) -> IO ())
-> (FunPtr (CExecCallback Any) -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (CExecCallback Any -> IO (FunPtr (CExecCallback Any))
forall a. CExecCallback a -> IO (FunPtr (CExecCallback a))
mkCExecCallback CExecCallback Any
forall a p.
Num a =>
p -> CColumnIndex -> Ptr CString -> Ptr CString -> IO a
cExecCallback) FunPtr (CExecCallback Any) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (CExecCallback Any) -> IO (Either (Error, Utf8) ()))
 -> IO (Either (Error, Utf8) ()))
-> (FunPtr (CExecCallback Any) -> IO (Either (Error, Utf8) ()))
-> IO (Either (Error, Utf8) ())
forall a b. (a -> b) -> a -> b
$ \FunPtr (CExecCallback Any)
pExecCallback -> do
            Either (Error, Utf8) ()
e <- (Ptr CString -> IO CError) -> IO (Either (Error, Utf8) ())
withErrorMessagePtr (Ptr CDatabase
-> CString
-> FunPtr (CExecCallback Any)
-> Ptr Any
-> Ptr CString
-> IO CError
forall a.
Ptr CDatabase
-> CString
-> FunPtr (CExecCallback a)
-> Ptr a
-> Ptr CString
-> IO CError
c_sqlite3_exec Ptr CDatabase
db CString
sql' FunPtr (CExecCallback Any)
pExecCallback Ptr Any
forall a. Ptr a
nullPtr)
            case Either (Error, Utf8) ()
e of
                Left r :: (Error, Utf8)
r@(Error
ErrorAbort, Utf8
_) -> do
                    Maybe SomeException
m <- IORef (Maybe SomeException) -> IO (Maybe SomeException)
forall a. IORef a -> IO a
readIORef IORef (Maybe SomeException)
abortReason
                    case Maybe SomeException
m of
                        Maybe SomeException
Nothing -> Either (Error, Utf8) () -> IO (Either (Error, Utf8) ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Error, Utf8) -> Either (Error, Utf8) ()
forall a b. a -> Either a b
Left (Error, Utf8)
r)
                        Just SomeException
ex -> SomeException -> IO (Either (Error, Utf8) ())
forall e a. Exception e => e -> IO a
throwIO SomeException
ex
                Either (Error, Utf8) ()
r               -> Either (Error, Utf8) () -> IO (Either (Error, Utf8) ())
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 ()
_ <- Ptr CDatabase
-> FunPtr (CTraceCallback Any) -> Ptr Any -> IO (Ptr ())
forall a.
Ptr CDatabase -> FunPtr (CTraceCallback a) -> Ptr a -> IO (Ptr ())
c_sqlite3_trace Ptr CDatabase
db FunPtr (CTraceCallback Any)
forall a. FunPtr a
nullFunPtr Ptr Any
forall a. Ptr a
nullPtr
            () -> IO ()
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 <- CTraceCallback Any -> IO (FunPtr (CTraceCallback Any))
forall a. CTraceCallback a -> IO (FunPtr (CTraceCallback a))
mkCTraceCallback (CTraceCallback Any -> IO (FunPtr (CTraceCallback Any)))
-> CTraceCallback Any -> IO (FunPtr (CTraceCallback Any))
forall a b. (a -> b) -> a -> b
$ \Ptr Any
_ctx CString
cStr -> do
                Utf8
msg <- Utf8 -> (Utf8 -> Utf8) -> CString -> IO Utf8
forall a. a -> (Utf8 -> a) -> CString -> IO a
packUtf8 Utf8
forall a. Monoid a => a
mempty Utf8 -> Utf8
forall a. a -> a
id CString
cStr
                Utf8 -> IO ()
output Utf8
msg
            Ptr ()
_ <- Ptr CDatabase
-> FunPtr (CTraceCallback Any) -> Ptr Any -> IO (Ptr ())
forall a.
Ptr CDatabase -> FunPtr (CTraceCallback a) -> Ptr a -> IO (Ptr ())
c_sqlite3_trace Ptr CDatabase
db FunPtr (CTraceCallback Any)
cb Ptr Any
forall a. Ptr a
nullPtr
            () -> IO ()
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) =
    (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (CInt -> Bool) -> IO CInt -> IO Bool
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 =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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) =
    ByteString
-> (CString -> IO (Either Error (Maybe Statement)))
-> IO (Either Error (Maybe Statement))
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
sql ((CString -> IO (Either Error (Maybe Statement)))
 -> IO (Either Error (Maybe Statement)))
-> (CString -> IO (Either Error (Maybe Statement)))
-> IO (Either Error (Maybe Statement))
forall a b. (a -> b) -> a -> b
$ \CString
sql' ->
        (Ptr (Ptr CStatement) -> IO (Either Error (Maybe Statement)))
-> IO (Either Error (Maybe Statement))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CStatement) -> IO (Either Error (Maybe Statement)))
 -> IO (Either Error (Maybe Statement)))
-> (Ptr (Ptr CStatement) -> IO (Either Error (Maybe Statement)))
-> IO (Either Error (Maybe Statement))
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CStatement)
statement ->
            Ptr CDatabase
-> CString
-> CNumBytes
-> Ptr (Ptr CStatement)
-> Ptr CString
-> IO CError
c_sqlite3_prepare_v2 Ptr CDatabase
db CString
sql' (-CNumBytes
1) Ptr (Ptr CStatement)
statement Ptr CString
forall a. Ptr a
nullPtr IO CError
-> (CError -> IO (Either Error (Maybe Statement)))
-> IO (Either Error (Maybe Statement))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                IO (Maybe Statement)
-> CError -> IO (Either Error (Maybe Statement))
forall (m :: * -> *) a.
Monad m =>
m a -> CError -> m (Either Error a)
toResultM ((Ptr CStatement -> Statement) -> Ptr CStatement -> Maybe Statement
forall a b. (Ptr a -> b) -> Ptr a -> Maybe b
wrapNullablePtr Ptr CStatement -> Statement
Statement (Ptr CStatement -> Maybe Statement)
-> IO (Ptr CStatement) -> IO (Maybe Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr CStatement) -> IO (Ptr CStatement)
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 Ptr CDatabase -> Ptr CDatabase -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CDatabase
forall a. Ptr a
nullPtr
        then String -> IO Database
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO Database) -> String -> IO Database
forall a b. (a -> b) -> a -> b
$ String
"sqlite3_db_handle(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ptr CStatement -> String
forall a. Show a => a -> String
show Ptr CStatement
stmt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") returned NULL"
        else Database -> IO Database
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 (CError -> Either Error StepResult)
-> IO CError -> IO (Either Error StepResult)
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 (CError -> Either Error StepResult)
-> IO CError -> IO (Either Error StepResult)
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) =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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) =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 CString
c_sqlite3_sql Ptr CStatement
stmt IO CString -> (CString -> IO (Maybe Utf8)) -> IO (Maybe Utf8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Utf8 -> (Utf8 -> Maybe Utf8) -> CString -> IO (Maybe Utf8)
forall a. a -> (Utf8 -> a) -> CString -> IO a
packUtf8 Maybe Utf8
forall a. Maybe a
Nothing Utf8 -> Maybe Utf8
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
    () -> IO ()
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) =
    CParamIndex -> ParamIndex
forall public ffi. FFIType public ffi => ffi -> public
fromFFI (CParamIndex -> ParamIndex) -> IO CParamIndex -> IO ParamIndex
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 CString
c_sqlite3_bind_parameter_name Ptr CStatement
stmt (ParamIndex -> CParamIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) IO CString -> (CString -> IO (Maybe Utf8)) -> IO (Maybe Utf8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Maybe Utf8 -> (Utf8 -> Maybe Utf8) -> CString -> IO (Maybe Utf8)
forall a. a -> (Utf8 -> a) -> CString -> IO a
packUtf8 Maybe Utf8
forall a. Maybe a
Nothing Utf8 -> Maybe Utf8
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) =
    ByteString
-> (CString -> IO (Maybe ParamIndex)) -> IO (Maybe ParamIndex)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO (Maybe ParamIndex)) -> IO (Maybe ParamIndex))
-> (CString -> IO (Maybe ParamIndex)) -> IO (Maybe ParamIndex)
forall a b. (a -> b) -> a -> b
$ \CString
name' -> do
        ParamIndex
idx <- CParamIndex -> ParamIndex
forall public ffi. FFIType public ffi => ffi -> public
fromFFI (CParamIndex -> ParamIndex) -> IO CParamIndex -> IO ParamIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> CString -> IO CParamIndex
c_sqlite3_bind_parameter_index Ptr CStatement
stmt CString
name'
        Maybe ParamIndex -> IO (Maybe ParamIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ParamIndex -> IO (Maybe ParamIndex))
-> Maybe ParamIndex -> IO (Maybe ParamIndex)
forall a b. (a -> b) -> a -> b
$ if ParamIndex
idx ParamIndex -> ParamIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ParamIndex
0 then Maybe ParamIndex
forall a. Maybe a
Nothing else ParamIndex -> Maybe ParamIndex
forall a. a -> Maybe a
Just ParamIndex
idx

-- | <https://www.sqlite.org/c3ref/column_count.html>
columnCount :: Statement -> IO ColumnCount
columnCount :: Statement -> IO ColumnCount
columnCount (Statement Ptr CStatement
stmt) =
    CColumnIndex -> ColumnCount
forall public ffi. FFIType public ffi => ffi -> public
fromFFI (CColumnIndex -> ColumnCount) -> IO CColumnIndex -> IO ColumnCount
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 -> ColumnCount -> IO (Maybe Utf8)
columnName (Statement Ptr CStatement
stmt) ColumnCount
idx =
    Ptr CStatement -> CColumnIndex -> IO CString
c_sqlite3_column_name Ptr CStatement
stmt (ColumnCount -> CColumnIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnCount
idx) IO CString -> (CString -> IO (Maybe Utf8)) -> IO (Maybe Utf8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Maybe Utf8 -> (Utf8 -> Maybe Utf8) -> CString -> IO (Maybe Utf8)
forall a. a -> (Utf8 -> a) -> CString -> IO a
packUtf8 Maybe Utf8
forall a. Maybe a
Nothing Utf8 -> Maybe Utf8
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 =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 (ParamIndex -> CParamIndex
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 =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 (ParamIndex -> CParamIndex
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) =
    ByteString
-> (CString -> CNumBytes -> IO (Either Error ()))
-> IO (Either Error ())
forall a. ByteString -> (CString -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value ((CString -> CNumBytes -> IO (Either Error ()))
 -> IO (Either Error ()))
-> (CString -> CNumBytes -> IO (Either Error ()))
-> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \CString
ptr CNumBytes
len ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CStatement
-> CParamIndex
-> CString
-> CNumBytes
-> Ptr CDestructor
-> IO CError
c_sqlite3_bind_text Ptr CStatement
stmt (ParamIndex -> CParamIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) CString
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 =
    ByteString
-> (CString -> CNumBytes -> IO (Either Error ()))
-> IO (Either Error ())
forall a. ByteString -> (CString -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value ((CString -> CNumBytes -> IO (Either Error ()))
 -> IO (Either Error ()))
-> (CString -> CNumBytes -> IO (Either Error ()))
-> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \CString
ptr CNumBytes
len ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CStatement
-> CParamIndex
-> CString
-> CNumBytes
-> Ptr CDestructor
-> IO CError
forall a.
Ptr CStatement
-> CParamIndex
-> Ptr a
-> CNumBytes
-> Ptr CDestructor
-> IO CError
c_sqlite3_bind_blob Ptr CStatement
stmt (ParamIndex -> CParamIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) CString
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 =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 (ParamIndex -> CParamIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx) (Int -> CInt
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 =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CStatement -> CParamIndex -> IO CError
c_sqlite3_bind_null Ptr CStatement
stmt (ParamIndex -> CParamIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ParamIndex
idx)

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

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

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

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

columnBlob :: Statement -> ColumnIndex -> IO ByteString
columnBlob :: Statement -> ColumnCount -> IO ByteString
columnBlob (Statement Ptr CStatement
stmt) ColumnCount
idx = do
    CString
ptr <- Ptr CStatement -> CColumnIndex -> IO CString
forall a. Ptr CStatement -> CColumnIndex -> IO (Ptr a)
c_sqlite3_column_blob Ptr CStatement
stmt (ColumnCount -> CColumnIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnCount
idx)
    CNumBytes
len <- Ptr CStatement -> CColumnIndex -> IO CNumBytes
c_sqlite3_column_bytes Ptr CStatement
stmt (ColumnCount -> CColumnIndex
forall public ffi. FFIType public ffi => public -> ffi
toFFI ColumnCount
idx)
    CString -> CNumBytes -> IO ByteString
packCStringLen CString
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) =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
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) =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
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 = IO (FunPtr (CFuncDestroy ())) -> FunPtr (CFuncDestroy ())
forall a. IO a -> a
IOU.unsafePerformIO (IO (FunPtr (CFuncDestroy ())) -> FunPtr (CFuncDestroy ()))
-> IO (FunPtr (CFuncDestroy ())) -> FunPtr (CFuncDestroy ())
forall a b. (a -> b) -> a -> b
$ CFuncDestroy () -> IO (FunPtr (CFuncDestroy ()))
forall a. CFuncDestroy a -> IO (FunPtr (CFuncDestroy a))
mkCFuncDestroy CFuncDestroy ()
destroy
  where
    destroy :: CFuncDestroy ()
destroy Ptr ()
p = do
        let p' :: StablePtr a
p' = Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
p
        CFuncPtrs FunPtr CFunc
p1 FunPtr CFunc
p2 FunPtr CFuncFinal
p3 <- StablePtr CFuncPtrs -> IO CFuncPtrs
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr CFuncPtrs
forall a. StablePtr a
p'
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr CFunc
p1 FunPtr CFunc -> FunPtr CFunc -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr CFunc
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr CFunc -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CFunc
p1
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr CFunc
p2 FunPtr CFunc -> FunPtr CFunc -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr CFunc
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr CFunc -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CFunc
p2
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr CFuncFinal
p3 FunPtr CFuncFinal -> FunPtr CFuncFinal -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr CFuncFinal
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr CFuncFinal -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CFuncFinal
p3
        StablePtr Any -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr StablePtr Any
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 = IO (Either Error ()) -> IO (Either Error ())
forall a. IO a -> IO a
mask_ (IO (Either Error ()) -> IO (Either Error ()))
-> IO (Either Error ()) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ do
    FunPtr CFunc
funPtr <- CFunc -> IO (FunPtr CFunc)
mkCFunc CFunc
fun'
    StablePtr CFuncPtrs
u <- CFuncPtrs -> IO (StablePtr CFuncPtrs)
forall a. a -> IO (StablePtr a)
newStablePtr (CFuncPtrs -> IO (StablePtr CFuncPtrs))
-> CFuncPtrs -> IO (StablePtr CFuncPtrs)
forall a b. (a -> b) -> a -> b
$ FunPtr CFunc -> FunPtr CFunc -> FunPtr CFuncFinal -> CFuncPtrs
CFuncPtrs FunPtr CFunc
funPtr FunPtr CFunc
forall a. FunPtr a
nullFunPtr FunPtr CFuncFinal
forall a. FunPtr a
nullFunPtr
    ByteString
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO (Either Error ())) -> IO (Either Error ()))
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CDatabase
-> CString
-> CArgCount
-> CInt
-> Ptr ()
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy ())
-> IO CError
forall a.
Ptr CDatabase
-> CString
-> CArgCount
-> CInt
-> Ptr a
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_function_v2
                Ptr CDatabase
db CString
namePtr (Maybe ArgCount -> CArgCount
maybeArgCount Maybe ArgCount
nArgs) CInt
flags (StablePtr CFuncPtrs -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr CFuncPtrs
u)
                FunPtr CFunc
funPtr FunPtr CFunc
forall a. FunPtr a
nullFunPtr FunPtr CFuncFinal
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 (IO () -> IO ()) -> IO () -> IO ()
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 :: 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 = IO (Either Error ()) -> IO (Either Error ())
forall a. IO a -> IO a
mask_ (IO (Either Error ()) -> IO (Either Error ()))
-> IO (Either Error ()) -> IO (Either Error ())
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 <- CFuncPtrs -> IO (StablePtr CFuncPtrs)
forall a. a -> IO (StablePtr a)
newStablePtr (CFuncPtrs -> IO (StablePtr CFuncPtrs))
-> CFuncPtrs -> IO (StablePtr CFuncPtrs)
forall a b. (a -> b) -> a -> b
$ FunPtr CFunc -> FunPtr CFunc -> FunPtr CFuncFinal -> CFuncPtrs
CFuncPtrs FunPtr CFunc
forall a. FunPtr a
nullFunPtr FunPtr CFunc
stepPtr FunPtr CFuncFinal
finalPtr
    ByteString
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO (Either Error ())) -> IO (Either Error ()))
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CDatabase
-> CString
-> CArgCount
-> CInt
-> Ptr ()
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy ())
-> IO CError
forall a.
Ptr CDatabase
-> CString
-> CArgCount
-> CInt
-> Ptr a
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_function_v2
                Ptr CDatabase
db CString
namePtr (Maybe ArgCount -> CArgCount
maybeArgCount Maybe ArgCount
nArgs) CInt
0 (StablePtr CFuncPtrs -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr CFuncPtrs
u)
                FunPtr CFunc
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Ptr (StablePtr (IORef a))
aggCtx <- Ptr CContext -> IO (Ptr (StablePtr (IORef a)))
forall a. Ptr CContext -> IO (Ptr a)
getAggregateContext Ptr CContext
ctx
            StablePtr (IORef a)
aggStPtr <- Ptr (StablePtr (IORef a)) -> IO (StablePtr (IORef a))
forall a. Storable a => Ptr a -> IO a
peek Ptr (StablePtr (IORef a))
aggCtx
            IORef a
aggStRef <-
                if StablePtr (IORef a) -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr (IORef a)
aggStPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ()
forall a. Ptr a
nullPtr then
                    StablePtr (IORef a) -> IO (IORef a)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (IORef a)
aggStPtr
                else do
                    IORef a
aggStRef <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
initSt
                    StablePtr (IORef a)
aggStPtr' <- IORef a -> IO (StablePtr (IORef a))
forall a. a -> IO (StablePtr a)
newStablePtr IORef a
aggStRef
                    Ptr (StablePtr (IORef a)) -> StablePtr (IORef a) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (StablePtr (IORef a))
aggCtx StablePtr (IORef a)
aggStPtr'
                    IORef a -> IO (IORef a)
forall (m :: * -> *) a. Monad m => a -> m a
return IORef a
aggStRef
            a
aggSt <- IORef a -> IO a
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
            IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
aggStRef a
aggSt'
    xFinal' :: CFuncFinal
xFinal' Ptr CContext
ctx = do
        Ptr (StablePtr (IORef a))
aggCtx <- Ptr CContext -> IO (Ptr (StablePtr (IORef a)))
forall a. Ptr CContext -> IO (Ptr a)
getAggregateContext Ptr CContext
ctx
        StablePtr (IORef a)
aggStPtr <- Ptr (StablePtr (IORef a)) -> IO (StablePtr (IORef a))
forall a. Storable a => Ptr a -> IO a
peek Ptr (StablePtr (IORef a))
aggCtx
        if StablePtr (IORef a) -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr (IORef a)
aggStPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr then
            Ptr CContext -> IO () -> IO ()
catchAsResultError Ptr CContext
ctx (IO () -> IO ()) -> IO () -> IO ()
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                IORef a
aggStRef <- StablePtr (IORef a) -> IO (IORef a)
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (IORef a)
aggStPtr
                a
aggSt <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
aggStRef
                FuncContext -> a -> IO ()
xFinal (Ptr CContext -> FuncContext
FuncContext Ptr CContext
ctx) a
aggSt
            StablePtr (IORef a) -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr StablePtr (IORef a)
aggStPtr
    getAggregateContext :: Ptr CContext -> IO (Ptr a)
getAggregateContext Ptr CContext
ctx =
        Ptr CContext -> CNumBytes -> IO (Ptr a)
forall a. Ptr CContext -> CNumBytes -> IO (Ptr a)
c_sqlite3_aggregate_context Ptr CContext
ctx CNumBytes
stPtrSize
    stPtrSize :: CNumBytes
stPtrSize = Int -> CNumBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CNumBytes) -> Int -> CNumBytes
forall a b. (a -> b) -> a -> b
$ StablePtr () -> Int
forall a. Storable a => a -> Int
sizeOf (StablePtr ()
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 = IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch IO ()
action ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
exn -> do
    let msg :: String
msg = SomeException -> String
forall a. Show a => a -> String
show (SomeException
exn :: SomeException)
    String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCAStringLen String
msg ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
        Ptr CContext -> CString -> CNumBytes -> IO ()
c_sqlite3_result_error Ptr CContext
ctx CString
ptr (Int -> CNumBytes
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 =
    ByteString
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO (Either Error ())) -> IO (Either Error ()))
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CDatabase
-> CString
-> CArgCount
-> CInt
-> Ptr Any
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy Any)
-> IO CError
forall a.
Ptr CDatabase
-> CString
-> CArgCount
-> CInt
-> Ptr a
-> FunPtr CFunc
-> FunPtr CFunc
-> FunPtr CFuncFinal
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_function_v2
                Ptr CDatabase
db CString
namePtr (Maybe ArgCount -> CArgCount
maybeArgCount Maybe ArgCount
nArgs) CInt
0 Ptr Any
forall a. Ptr a
nullPtr
                FunPtr CFunc
forall a. FunPtr a
nullFunPtr FunPtr CFunc
forall a. FunPtr a
nullFunPtr FunPtr CFuncFinal
forall a. FunPtr a
nullFunPtr FunPtr (CFuncDestroy Any)
forall a. FunPtr a
nullFunPtr

maybeArgCount :: Maybe ArgCount -> CArgCount
maybeArgCount :: Maybe ArgCount -> CArgCount
maybeArgCount (Just ArgCount
n) = ArgCount -> CArgCount
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)
_) = CArgCount -> ArgCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral CArgCount
nArgs

funcArgType :: FuncArgs -> ArgIndex -> IO ColumnType
funcArgType :: FuncArgs -> ArgCount -> IO ColumnType
funcArgType =
    ColumnType
-> (Ptr CValue -> IO ColumnType)
-> FuncArgs
-> ArgCount
-> IO ColumnType
forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg ColumnType
NullColumn ((CColumnType -> ColumnType) -> IO CColumnType -> IO ColumnType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CColumnType -> ColumnType
decodeColumnType (IO CColumnType -> IO ColumnType)
-> (Ptr CValue -> IO CColumnType) -> Ptr CValue -> IO ColumnType
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 = Int64
-> (Ptr CValue -> IO Int64) -> FuncArgs -> ArgCount -> IO Int64
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 = Double
-> (Ptr CValue -> IO Double) -> FuncArgs -> ArgCount -> IO Double
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 = Utf8 -> (Ptr CValue -> IO Utf8) -> FuncArgs -> ArgCount -> IO Utf8
forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg Utf8
forall a. Monoid a => a
mempty ((Ptr CValue -> IO Utf8) -> FuncArgs -> ArgCount -> IO Utf8)
-> (Ptr CValue -> IO Utf8) -> FuncArgs -> ArgCount -> IO Utf8
forall a b. (a -> b) -> a -> b
$ \Ptr CValue
cval -> do
    CString
ptr <- Ptr CValue -> IO CString
c_sqlite3_value_text Ptr CValue
cval
    CNumBytes
len <- Ptr CValue -> IO CNumBytes
c_sqlite3_value_bytes Ptr CValue
cval
    ByteString -> Utf8
Utf8 (ByteString -> Utf8) -> IO ByteString -> IO Utf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> CNumBytes -> IO ByteString
packCStringLen CString
ptr CNumBytes
len

funcArgBlob :: FuncArgs -> ArgIndex -> IO ByteString
funcArgBlob :: FuncArgs -> ArgCount -> IO ByteString
funcArgBlob  = ByteString
-> (Ptr CValue -> IO ByteString)
-> FuncArgs
-> ArgCount
-> IO ByteString
forall a. a -> (Ptr CValue -> IO a) -> FuncArgs -> ArgCount -> IO a
extractFuncArg ByteString
forall a. Monoid a => a
mempty ((Ptr CValue -> IO ByteString)
 -> FuncArgs -> ArgCount -> IO ByteString)
-> (Ptr CValue -> IO ByteString)
-> FuncArgs
-> ArgCount
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CValue
cval -> do
    CString
ptr <- Ptr CValue -> IO CString
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
    CString -> CNumBytes -> IO ByteString
packCStringLen CString
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 :: 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 ArgCount -> ArgCount -> Bool
forall a. Ord a => a -> a -> Bool
<= ArgCount
idx Bool -> Bool -> Bool
&& ArgCount
idx ArgCount -> ArgCount -> Bool
forall a. Ord a => a -> a -> Bool
< CArgCount -> ArgCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral CArgCount
nArgs = do
        Ptr CValue
cval <- Ptr (Ptr CValue) -> Int -> IO (Ptr CValue)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr CValue)
p (ArgCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ArgCount
idx)
        Ptr CValue -> IO a
extract Ptr CValue
cval
    | Bool
otherwise = a -> IO a
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) =
    ByteString -> (CString -> CNumBytes -> IO ()) -> IO ()
forall a. ByteString -> (CString -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value ((CString -> CNumBytes -> IO ()) -> IO ())
-> (CString -> CNumBytes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ptr CNumBytes
len ->
        Ptr CContext -> CString -> CNumBytes -> Ptr CDestructor -> IO ()
c_sqlite3_result_text Ptr CContext
ctx CString
ptr CNumBytes
len Ptr CDestructor
c_SQLITE_TRANSIENT

funcResultBlob :: FuncContext -> ByteString -> IO ()
funcResultBlob :: FuncContext -> ByteString -> IO ()
funcResultBlob (FuncContext Ptr CContext
ctx) ByteString
value =
    ByteString -> (CString -> CNumBytes -> IO ()) -> IO ()
forall a. ByteString -> (CString -> CNumBytes -> IO a) -> IO a
unsafeUseAsCStringLenNoNull ByteString
value ((CString -> CNumBytes -> IO ()) -> IO ())
-> (CString -> CNumBytes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ptr CNumBytes
len ->
        Ptr CContext -> CString -> CNumBytes -> Ptr CDestructor -> IO ()
forall a.
Ptr CContext -> Ptr a -> CNumBytes -> Ptr CDestructor -> IO ()
c_sqlite3_result_blob Ptr CContext
ctx CString
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 (Int -> CNumBytes
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 Ptr CDatabase -> Ptr CDatabase -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CDatabase
forall a. Ptr a
nullPtr
        then String -> IO Database
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO Database) -> String -> IO Database
forall a b. (a -> b) -> a -> b
$ String
"sqlite3_context_db_handle(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ptr CContext -> String
forall a. Show a => a -> String
show Ptr CContext
ctx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") returned NULL"
        else Database -> IO Database
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 = FunPtr (CCompare ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr (CCompare ())
ptr'
  where
    ptr' :: FunPtr (CCompare ())
ptr' = Ptr () -> FunPtr (CCompare ())
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 = IO (FunPtr (CFuncDestroy ())) -> FunPtr (CFuncDestroy ())
forall a. IO a -> a
IOU.unsafePerformIO (IO (FunPtr (CFuncDestroy ())) -> FunPtr (CFuncDestroy ()))
-> IO (FunPtr (CFuncDestroy ())) -> FunPtr (CFuncDestroy ())
forall a b. (a -> b) -> a -> b
$ CFuncDestroy () -> IO (FunPtr (CFuncDestroy ()))
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 = IO (Either Error ()) -> IO (Either Error ())
forall a. IO a -> IO a
mask_ (IO (Either Error ()) -> IO (Either Error ()))
-> IO (Either Error ()) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ do
    FunPtr (CCompare ())
cmpPtr <- CCompare () -> IO (FunPtr (CCompare ()))
forall a. CCompare a -> IO (FunPtr (CCompare a))
mkCCompare CCompare ()
forall a p.
Num a =>
p -> CNumBytes -> CString -> CNumBytes -> CString -> IO a
cmp'
    let u :: Ptr b
u = FunPtr (CCompare ()) -> Ptr b
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (CCompare ())
cmpPtr
    ByteString
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO (Either Error ())) -> IO (Either Error ()))
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            CError
r <- Ptr CDatabase
-> CString
-> CInt
-> Ptr ()
-> FunPtr (CCompare ())
-> FunPtr (CFuncDestroy ())
-> IO CError
forall a.
Ptr CDatabase
-> CString
-> CInt
-> Ptr a
-> FunPtr (CCompare a)
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_collation_v2
                Ptr CDatabase
db CString
namePtr CInt
c_SQLITE_UTF8 Ptr ()
forall a. Ptr a
u FunPtr (CCompare ())
cmpPtr FunPtr (CFuncDestroy ())
destroyCComparePtr
            -- sqlite does not call the destructor for us in case of an
            -- error
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CError
r CError -> CError -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> CError
CError CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                CFuncDestroy ()
destroyCCompare CFuncDestroy () -> CFuncDestroy ()
forall a b. (a -> b) -> a -> b
$ FunPtr (CCompare ()) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (CCompare ())
cmpPtr
            CError -> IO CError
forall (m :: * -> *) a. Monad m => a -> m a
return CError
r
  where
    cmp' :: p -> CNumBytes -> CString -> CNumBytes -> CString -> IO a
cmp' p
_ CNumBytes
len1 CString
ptr1 CNumBytes
len2 CString
ptr2 = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO a
forall (m :: * -> *) a. (Monad m, Num a) => SomeException -> m a
exnHandler (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
        Utf8
s1 <- ByteString -> Utf8
Utf8 (ByteString -> Utf8) -> IO ByteString -> IO Utf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> CNumBytes -> IO ByteString
packCStringLen CString
ptr1 CNumBytes
len1
        Utf8
s2 <- ByteString -> Utf8
Utf8 (ByteString -> Utf8) -> IO ByteString -> IO Utf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> CNumBytes -> IO ByteString
packCStringLen CString
ptr2 CNumBytes
len2
        let c :: Ordering
c = Utf8 -> Utf8 -> Ordering
cmp Utf8
s1 Utf8
s2
        a -> IO a
forall a. a -> IO a
evaluate (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Ordering -> Int
forall a. Enum a => a -> Int
fromEnum Ordering
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    exnHandler :: SomeException -> m a
exnHandler (SomeException
_ :: SomeException) = a -> m a
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) =
    ByteString
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO (Either Error ())) -> IO (Either Error ()))
-> (CString -> IO (Either Error ())) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \CString
namePtr ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CDatabase
-> CString
-> CInt
-> Ptr Any
-> FunPtr (CCompare Any)
-> FunPtr (CFuncDestroy Any)
-> IO CError
forall a.
Ptr CDatabase
-> CString
-> CInt
-> Ptr a
-> FunPtr (CCompare a)
-> FunPtr (CFuncDestroy a)
-> IO CError
c_sqlite3_create_collation_v2
                Ptr CDatabase
db CString
namePtr CInt
c_SQLITE_UTF8 Ptr Any
forall a. Ptr a
nullPtr FunPtr (CCompare Any)
forall a. FunPtr a
nullFunPtr FunPtr (CFuncDestroy Any)
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 =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 =
    ByteString
-> (CString -> IO (Either Error Blob)) -> IO (Either Error Blob)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
zDb ((CString -> IO (Either Error Blob)) -> IO (Either Error Blob))
-> (CString -> IO (Either Error Blob)) -> IO (Either Error Blob)
forall a b. (a -> b) -> a -> b
$ \CString
ptrDb ->
    ByteString
-> (CString -> IO (Either Error Blob)) -> IO (Either Error Blob)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
zTable ((CString -> IO (Either Error Blob)) -> IO (Either Error Blob))
-> (CString -> IO (Either Error Blob)) -> IO (Either Error Blob)
forall a b. (a -> b) -> a -> b
$ \CString
ptrTable ->
    ByteString
-> (CString -> IO (Either Error Blob)) -> IO (Either Error Blob)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
zColumn ((CString -> IO (Either Error Blob)) -> IO (Either Error Blob))
-> (CString -> IO (Either Error Blob)) -> IO (Either Error Blob)
forall a b. (a -> b) -> a -> b
$ \CString
ptrColumn ->
    (Ptr (Ptr CBlob) -> IO (Either Error Blob))
-> IO (Either Error Blob)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CBlob) -> IO (Either Error Blob))
 -> IO (Either Error Blob))
-> (Ptr (Ptr CBlob) -> IO (Either Error Blob))
-> IO (Either Error Blob)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CBlob)
ptrBlob ->
        Ptr CDatabase
-> CString
-> CString
-> CString
-> Int64
-> CInt
-> Ptr (Ptr CBlob)
-> IO CError
c_sqlite3_blob_open Ptr CDatabase
db CString
ptrDb CString
ptrTable CString
ptrColumn Int64
rowid CInt
flags Ptr (Ptr CBlob)
ptrBlob
            IO CError
-> (CError -> IO (Either Error Blob)) -> IO (Either Error Blob)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Blob -> CError -> IO (Either Error Blob)
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) (Ptr CBlob -> Blob) -> IO (Ptr CBlob) -> IO Blob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr CBlob) -> IO (Ptr CBlob)
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) =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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) =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
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 <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
BSI.mallocByteString Int
len
    (() -> ByteString) -> Either Error () -> Either Error ByteString
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) (Either Error () -> Either Error ByteString)
-> IO (Either Error ()) -> IO (Either Error ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ForeignPtr Word8
-> (Ptr Word8 -> IO (Either Error ())) -> IO (Either Error ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
p -> Blob -> Ptr Word8 -> Int -> Int -> IO (Either Error ())
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 :: Blob -> Ptr a -> Int -> Int -> IO (Either Error ())
blobReadBuf (Blob Database
_ Ptr CBlob
blob) Ptr a
buf Int
len Int
offset =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Ptr CBlob -> Ptr a -> CInt -> CInt -> IO CError
forall a. Ptr CBlob -> Ptr a -> CInt -> CInt -> IO CError
c_sqlite3_blob_read Ptr CBlob
blob Ptr a
buf (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Int -> CInt
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 =
    ByteString
-> (CStringLen -> IO (Either Error ())) -> IO (Either Error ())
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Either Error ())) -> IO (Either Error ()))
-> (CStringLen -> IO (Either Error ())) -> IO (Either Error ())
forall a b. (a -> b) -> a -> b
$ \(CString
buf, Int
len) ->
        () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Ptr CBlob -> CString -> CInt -> CInt -> IO CError
forall a. Ptr CBlob -> Ptr a -> CInt -> CInt -> IO CError
c_sqlite3_blob_write Ptr CBlob
blob CString
buf (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Int -> CInt
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) =
    ByteString
-> (CString -> IO (Either Error Backup))
-> IO (Either Error Backup)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
dstName ((CString -> IO (Either Error Backup)) -> IO (Either Error Backup))
-> (CString -> IO (Either Error Backup))
-> IO (Either Error Backup)
forall a b. (a -> b) -> a -> b
$ \CString
dstName' ->
    ByteString
-> (CString -> IO (Either Error Backup))
-> IO (Either Error Backup)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
srcName ((CString -> IO (Either Error Backup)) -> IO (Either Error Backup))
-> (CString -> IO (Either Error Backup))
-> IO (Either Error Backup)
forall a b. (a -> b) -> a -> b
$ \CString
srcName' -> do
        Ptr CBackup
r <- Ptr CDatabase
-> CString -> Ptr CDatabase -> CString -> IO (Ptr CBackup)
c_sqlite3_backup_init Ptr CDatabase
dstDb CString
dstName' Ptr CDatabase
srcDb CString
srcName'
        if Ptr CBackup
r Ptr CBackup -> Ptr CBackup -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CBackup
forall a. Ptr a
nullPtr
            then Error -> Either Error Backup
forall a b. a -> Either a b
Left (Error -> Either Error Backup)
-> IO Error -> IO (Either Error Backup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Database -> IO Error
errcode (Ptr CDatabase -> Database
Database Ptr CDatabase
dstDb)
            else Either Error Backup -> IO (Either Error Backup)
forall (m :: * -> *) a. Monad m => a -> m a
return (Backup -> Either Error Backup
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) =
    () -> CError -> Either Error ()
forall a. a -> CError -> Either Error a
toResult () (CError -> Either Error ()) -> IO CError -> IO (Either Error ())
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 (CError -> Either Error BackupStepResult)
-> IO CError -> IO (Either Error BackupStepResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Ptr CBackup -> CInt -> IO CError
c_sqlite3_backup_step Ptr CBackup
backup (Int -> CInt
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) =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
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) =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBackup -> IO CInt
c_sqlite3_backup_pagecount Ptr CBackup
backup