{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.SQLite3 (
    -- * Connection management
    open,
    close,

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

    -- * Statement management
    prepare,
    prepareUtf8,
    step,
    stepNoCB,
    reset,
    finalize,
    clearBindings,

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

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

    -- * Reading the result row
    -- | <https://www.sqlite.org/c3ref/column_blob.html>
    --
    -- Warning: 'column' and 'columns' will throw a 'DecodeError' if any @TEXT@
    -- datum contains invalid UTF-8.
    column,
    columns,
    typedColumns,
    columnType,
    columnInt64,
    columnDouble,
    columnText,
    columnBlob,

    -- * Result statistics
    lastInsertRowId,
    changes,

    -- * Create custom SQL functions
    createFunction,
    createAggregate,
    deleteFunction,
    -- ** Extract function arguments
    funcArgCount,
    funcArgType,
    funcArgInt64,
    funcArgDouble,
    funcArgText,
    funcArgBlob,
    -- ** Set the result of a function
    funcResultSQLData,
    funcResultInt64,
    funcResultDouble,
    funcResultText,
    funcResultBlob,
    funcResultZeroBlob,
    funcResultNull,
    getFuncContextDatabase,

    -- * Create custom collations
    createCollation,
    deleteCollation,

    -- * Interrupting a long-running query
    interrupt,
    interruptibly,

    -- * 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,
    SQLData(..),
    SQLError(..),
    ColumnType(..),
    FuncContext,
    FuncArgs,
    Blob,
    Backup,

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

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

import Database.SQLite3.Direct
    ( Database
    , Statement
    , ColumnType(..)
    , StepResult(..)
    , BackupStepResult(..)
    , Error(..)
    , ParamIndex(..)
    , ColumnIndex(..)
    , ColumnCount
    , Utf8(..)
    , FuncContext
    , FuncArgs
    , ArgCount(..)
    , ArgIndex
    , Blob
    , Backup

    -- Re-exported from Database.SQLite3.Direct without modification.
    -- Note that if this module were in another package, source links would not
    -- be generated for these functions.
    , clearBindings
    , bindParameterCount
    , columnCount
    , columnType
    , columnBlob
    , columnInt64
    , columnDouble
    , funcArgCount
    , funcArgType
    , funcArgInt64
    , funcArgDouble
    , funcArgBlob
    , funcResultInt64
    , funcResultDouble
    , funcResultBlob
    , funcResultZeroBlob
    , funcResultNull
    , getFuncContextDatabase
    , lastInsertRowId
    , changes
    , interrupt
    , blobBytes
    , backupRemaining
    , backupPagecount
    )

import qualified Database.SQLite3.Direct as Direct

import Prelude hiding (error)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Control.Concurrent
import Control.Exception
import Control.Monad        (when, zipWithM, zipWithM_)
import Data.ByteString      (ByteString)
import Data.Int             (Int64)
import Data.Maybe           (fromMaybe)
import Data.Text            (Text)
import Data.Text.Encoding   (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (UnicodeException(..), lenientDecode)
import Data.Typeable
import Foreign.Ptr          (Ptr)

data SQLData
    = SQLInteger    !Int64
    | SQLFloat      !Double
    | SQLText       !Text
    | SQLBlob       !ByteString
    | SQLNull
    deriving (SQLData -> SQLData -> Bool
(SQLData -> SQLData -> Bool)
-> (SQLData -> SQLData -> Bool) -> Eq SQLData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SQLData -> SQLData -> Bool
$c/= :: SQLData -> SQLData -> Bool
== :: SQLData -> SQLData -> Bool
$c== :: SQLData -> SQLData -> Bool
Eq, Int -> SQLData -> ShowS
[SQLData] -> ShowS
SQLData -> String
(Int -> SQLData -> ShowS)
-> (SQLData -> String) -> ([SQLData] -> ShowS) -> Show SQLData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SQLData] -> ShowS
$cshowList :: [SQLData] -> ShowS
show :: SQLData -> String
$cshow :: SQLData -> String
showsPrec :: Int -> SQLData -> ShowS
$cshowsPrec :: Int -> SQLData -> ShowS
Show, Typeable)

-- | Exception thrown when SQLite3 reports an error.
--
-- direct-sqlite may throw other types of exceptions if you misuse the API.
data SQLError = SQLError
    { SQLError -> Error
sqlError          :: !Error
        -- ^ Error code returned by API call
    , SQLError -> Text
sqlErrorDetails   :: Text
        -- ^ Text describing the error
    , SQLError -> Text
sqlErrorContext   :: Text
        -- ^ Indicates what action produced this error,
        --   e.g. @exec \"SELECT * FROM foo\"@
    }
    deriving (SQLError -> SQLError -> Bool
(SQLError -> SQLError -> Bool)
-> (SQLError -> SQLError -> Bool) -> Eq SQLError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SQLError -> SQLError -> Bool
$c/= :: SQLError -> SQLError -> Bool
== :: SQLError -> SQLError -> Bool
$c== :: SQLError -> SQLError -> Bool
Eq, Typeable)

-- NB: SQLError is lazy in 'sqlErrorDetails' and 'sqlErrorContext',
-- to defer message construction in the case where a user catches and
-- immediately handles the error.

instance Show SQLError where
    show :: SQLError -> String
show SQLError{ sqlError :: SQLError -> Error
sqlError        = Error
code
                 , sqlErrorDetails :: SQLError -> Text
sqlErrorDetails = Text
details
                 , sqlErrorContext :: SQLError -> Text
sqlErrorContext = Text
context
                 }
         = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
         [ Text
"SQLite3 returned "
         , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
code
         , Text
" while attempting to perform "
         , Text
context
         , Text
": "
         , Text
details
         ]

instance Exception SQLError

-- | Like 'decodeUtf8', but substitute a custom error message if
-- decoding fails.
fromUtf8 :: String -> Utf8 -> IO Text
fromUtf8 :: String -> Utf8 -> IO Text
fromUtf8 String
desc Utf8
utf8 = Text -> IO Text
forall a. a -> IO a
evaluate (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Utf8 -> Text
fromUtf8' String
desc Utf8
utf8

fromUtf8' :: String -> Utf8 -> Text
fromUtf8' :: String -> Utf8 -> Text
fromUtf8' String
desc (Utf8 ByteString
bs) =
    OnDecodeError -> ByteString -> Text
decodeUtf8With (\String
_ Maybe Word8
c -> UnicodeException -> Maybe Char
forall a e. Exception e => e -> a
throw (String -> Maybe Word8 -> UnicodeException
DecodeError String
desc Maybe Word8
c)) ByteString
bs

toUtf8 :: Text -> Utf8
toUtf8 :: Text -> Utf8
toUtf8 = ByteString -> Utf8
Utf8 (ByteString -> Utf8) -> (Text -> ByteString) -> Text -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

data DetailSource
    = DetailDatabase    Database
    | DetailStatement   Statement
    | DetailMessage     Utf8

renderDetailSource :: DetailSource -> IO Utf8
renderDetailSource :: DetailSource -> IO Utf8
renderDetailSource DetailSource
src = case DetailSource
src of
    DetailDatabase Database
db ->
        Database -> IO Utf8
Direct.errmsg Database
db
    DetailStatement Statement
stmt -> do
        Database
db <- Statement -> IO Database
Direct.getStatementDatabase Statement
stmt
        Database -> IO Utf8
Direct.errmsg Database
db
    DetailMessage Utf8
msg ->
        Utf8 -> IO Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return Utf8
msg

throwSQLError :: DetailSource -> Text -> Error -> IO a
throwSQLError :: DetailSource -> Text -> Error -> IO a
throwSQLError DetailSource
detailSource Text
context Error
error = do
    Utf8 ByteString
details <- DetailSource -> IO Utf8
renderDetailSource DetailSource
detailSource
    SQLError -> IO a
forall e a. Exception e => e -> IO a
throwIO SQLError :: Error -> Text -> Text -> SQLError
SQLError
        { sqlError :: Error
sqlError        = Error
error
        , sqlErrorDetails :: Text
sqlErrorDetails = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
details
        , sqlErrorContext :: Text
sqlErrorContext = Text
context
        }

checkError :: DetailSource -> Text -> Either Error a -> IO a
checkError :: DetailSource -> Text -> Either Error a -> IO a
checkError DetailSource
ds Text
fn = (Error -> IO a) -> (a -> IO a) -> Either Error a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (DetailSource -> Text -> Error -> IO a
forall a. DetailSource -> Text -> Error -> IO a
throwSQLError DetailSource
ds Text
fn) a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

checkErrorMsg :: Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg :: Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg Text
fn Either (Error, Utf8) a
result = case Either (Error, Utf8) a
result of
    Left (Error
err, Utf8
msg) -> DetailSource -> Text -> Error -> IO a
forall a. DetailSource -> Text -> Error -> IO a
throwSQLError (Utf8 -> DetailSource
DetailMessage Utf8
msg) Text
fn Error
err
    Right a
a         -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

appendShow :: Show a => Text -> a -> Text
appendShow :: Text -> a -> Text
appendShow Text
txt a
a = Text
txt Text -> Text -> Text
`T.append` (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) a
a

-- | <https://www.sqlite.org/c3ref/open.html>
open :: Text -> IO Database
open :: Text -> IO Database
open Text
path =
    Utf8 -> IO (Either (Error, Utf8) Database)
Direct.open (Text -> Utf8
toUtf8 Text
path)
        IO (Either (Error, Utf8) Database)
-> (Either (Error, Utf8) Database -> IO Database) -> IO Database
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either (Error, Utf8) Database -> IO Database
forall a. Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg (Text
"open " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
path)

-- | <https://www.sqlite.org/c3ref/close.html>
close :: Database -> IO ()
close :: Database -> IO ()
close Database
db =
    Database -> IO (Either Error ())
Direct.close Database
db IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) Text
"close"

-- | Make it possible to interrupt the given database operation with an
-- asynchronous exception.  This only works if the program is compiled with
-- base >= 4.3 and @-threaded@.
--
-- It works by running the callback in a forked thread.  If interrupted,
-- it uses 'interrupt' to try to stop the operation.
interruptibly :: Database -> IO a -> IO a
#if MIN_VERSION_base(4,3,0)
interruptibly :: Database -> IO a -> IO a
interruptibly Database
db IO a
io
  | Bool
rtsSupportsBoundThreads =
      ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
          MVar (Either SomeException a)
mv <- IO (MVar (Either SomeException a))
forall a. IO (MVar a)
newEmptyMVar
          ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either SomeException a)
forall a. IO a -> IO (Either SomeException a)
try' (IO a -> IO a
forall a. IO a -> IO a
restore IO a
io) IO (Either SomeException a)
-> (Either SomeException a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Either SomeException a) -> Either SomeException a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException a)
mv

          let interruptAndWait :: IO ()
interruptAndWait =
                  -- Don't let a second exception interrupt us.  Otherwise,
                  -- the operation will dangle in the background, which could
                  -- be really bad if it uses locally-allocated resources.
                  IO () -> IO ()
forall a. IO a -> IO a
uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                      -- Tell SQLite3 to interrupt the current query.
                      Database -> IO ()
interrupt Database
db

                      -- Interrupt the thread in case it's blocked for some
                      -- other reason.
                      --
                      -- NOTE: killThread blocks until the exception is delivered.
                      -- That's fine, since we're going to wait for the thread
                      -- to finish anyway.
                      ThreadId -> IO ()
killThread ThreadId
tid

                      -- Wait for the forked thread to finish.
                      Either SomeException a
_ <- MVar (Either SomeException a) -> IO (Either SomeException a)
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException a)
mv
                      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

          Either SomeException a
e <- MVar (Either SomeException a) -> IO (Either SomeException a)
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException a)
mv IO (Either SomeException a) -> IO () -> IO (Either SomeException a)
forall a b. IO a -> IO b -> IO a
`onException` IO ()
interruptAndWait
          (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either SomeException a
e
  | Bool
otherwise = IO a
io
  where
    try' :: IO a -> IO (Either SomeException a)
    try' :: IO a -> IO (Either SomeException a)
try' = IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try
#else
interruptibly _db io = io
#endif

-- | Execute zero or more SQL statements delimited by semicolons.
exec :: Database -> Text -> IO ()
exec :: Database -> Text -> IO ()
exec Database
db Text
sql =
    Database -> Utf8 -> IO (Either (Error, Utf8) ())
Direct.exec Database
db (Text -> Utf8
toUtf8 Text
sql)
        IO (Either (Error, Utf8) ())
-> (Either (Error, Utf8) () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either (Error, Utf8) () -> IO ()
forall a. Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg (Text
"exec " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
sql)

-- | Like 'exec', but print result rows to 'System.IO.stdout'.
--
-- This is mainly for convenience when experimenting in GHCi.
-- The output format may change in the future.
execPrint :: Database -> Text -> IO ()
execPrint :: Database -> Text -> IO ()
execPrint !Database
db !Text
sql =
    Database -> IO () -> IO ()
forall a. Database -> IO a -> IO a
interruptibly Database
db (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Database -> Text -> ExecCallback -> IO ()
execWithCallback Database
db Text
sql (ExecCallback -> IO ()) -> ExecCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \ColumnCount
_count [Text]
_colnames -> Text -> IO ()
T.putStrLn (Text -> IO ()) -> ([Maybe Text] -> Text) -> [Maybe Text] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> Text
showValues
  where
    -- This mimics sqlite3's default output mode.  It displays a NULL and an
    -- empty string identically.
    showValues :: [Maybe Text] -> Text
showValues = Text -> [Text] -> Text
T.intercalate Text
"|" ([Text] -> Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Text) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"")

-- | Like 'exec', but invoke the callback for each result row.
execWithCallback :: Database -> Text -> ExecCallback -> IO ()
execWithCallback :: Database -> Text -> ExecCallback -> IO ()
execWithCallback Database
db Text
sql ExecCallback
cb =
    Database -> Utf8 -> ExecCallback -> IO (Either (Error, Utf8) ())
Direct.execWithCallback Database
db (Text -> Utf8
toUtf8 Text
sql) ExecCallback
cb'
        IO (Either (Error, Utf8) ())
-> (Either (Error, Utf8) () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either (Error, Utf8) () -> IO ()
forall a. Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg (Text
"execWithCallback " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
sql)
  where
    -- We want 'names' computed once and shared with every call.
    cb' :: ExecCallback
cb' ColumnCount
count [Utf8]
namesUtf8 =
       let names :: [Text]
names = (Utf8 -> Text) -> [Utf8] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Utf8 -> Text
fromUtf8'' [Utf8]
namesUtf8
           {-# NOINLINE names #-}
        in ExecCallback
cb ColumnCount
count [Text]
names ([Maybe Text] -> IO ())
-> ([Maybe Utf8] -> [Maybe Text]) -> [Maybe Utf8] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Utf8 -> Maybe Text) -> [Maybe Utf8] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Utf8 -> Text) -> Maybe Utf8 -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Utf8 -> Text
fromUtf8'')

    fromUtf8'' :: Utf8 -> Text
fromUtf8'' = String -> Utf8 -> Text
fromUtf8' String
"Database.SQLite3.execWithCallback: Invalid UTF-8"

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

-- | <https://www.sqlite.org/c3ref/prepare.html>
--
-- Unlike 'exec', 'prepare' only executes the first statement, and ignores
-- subsequent statements.
--
-- If the query string contains no SQL statements, this 'fail's.
prepare :: Database -> Text -> IO Statement
prepare :: Database -> Text -> IO Statement
prepare Database
db Text
sql = Database -> Utf8 -> IO Statement
prepareUtf8 Database
db (Text -> Utf8
toUtf8 Text
sql)

-- | <https://www.sqlite.org/c3ref/prepare.html>
--
-- It can help to avoid redundant Utf8 to Text conversion if you already
-- have Utf8
--
-- If the query string contains no SQL statements, this 'fail's.
prepareUtf8 :: Database -> Utf8 -> IO Statement
prepareUtf8 :: Database -> Utf8 -> IO Statement
prepareUtf8 Database
db Utf8
sql = do
    Maybe Statement
m <- Database -> Utf8 -> IO (Either Error (Maybe Statement))
Direct.prepare Database
db Utf8
sql
            IO (Either Error (Maybe Statement))
-> (Either Error (Maybe Statement) -> IO (Maybe Statement))
-> IO (Maybe Statement)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource
-> Text -> Either Error (Maybe Statement) -> IO (Maybe Statement)
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"prepare " Text -> Utf8 -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Utf8
sql)
    case Maybe Statement
m of
        Maybe Statement
Nothing   -> String -> IO Statement
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Direct.SQLite3.prepare: empty query string"
        Just Statement
stmt -> Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
stmt

-- | <https://www.sqlite.org/c3ref/step.html>
step :: Statement -> IO StepResult
step :: Statement -> IO StepResult
step Statement
statement =
    Statement -> IO (Either Error StepResult)
Direct.step Statement
statement IO (Either Error StepResult)
-> (Either Error StepResult -> IO StepResult) -> IO StepResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error StepResult -> IO StepResult
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"step"

-- | <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 StepResult
stepNoCB :: Statement -> IO StepResult
stepNoCB Statement
statement =
    Statement -> IO (Either Error StepResult)
Direct.stepNoCB Statement
statement IO (Either Error StepResult)
-> (Either Error StepResult -> IO StepResult) -> IO StepResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error StepResult -> IO StepResult
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"stepNoCB"

-- Note: sqlite3_reset and sqlite3_finalize return an error code if the most
-- recent sqlite3_step indicated an error.  I think these are the only times
-- these functions return an error (barring memory corruption and misuse of the API).
--
-- We don't replicate that behavior here.  Instead, 'reset' and 'finalize'
-- discard the error.  Otherwise, we would get "double jeopardy".
-- For example:
--
--  ok <- try $ step stmt :: IO (Either SQLError StepResult)
--  finalize stmt
--
-- If 'finalize' threw its error, it would throw the exception the user was
-- trying to catch.
--
-- 'reset' and 'finalize' might return a different error than the step that
-- failed, leading to more cryptic error messages [1].  But we're not
-- completely sure about this.
--
--  [1]: https://github.com/yesodweb/persistent/issues/92#issuecomment-7806421

-- | <https://www.sqlite.org/c3ref/reset.html>
--
-- Note that in the C API, @sqlite3_reset@ returns an error code if the most
-- recent @sqlite3_step@ indicated an error.  We do not replicate that behavior
-- here.  'reset' never throws an exception.
reset :: Statement -> IO ()
reset :: Statement -> IO ()
reset Statement
statement = do
    Either Error ()
_ <- Statement -> IO (Either Error ())
Direct.reset Statement
statement
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | <https://www.sqlite.org/c3ref/finalize.html>
--
-- Like 'reset', 'finalize' never throws an exception.
finalize :: Statement -> IO ()
finalize :: Statement -> IO ()
finalize Statement
statement = do
    Either Error ()
_ <- Statement -> IO (Either Error ())
Direct.finalize Statement
statement
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | <https://www.sqlite.org/c3ref/bind_parameter_name.html>
--
-- Return the N-th SQL parameter name.
--
-- Named parameters are returned as-is.  E.g. \":v\" is returned as
-- @Just \":v\"@.  Unnamed parameters, however, are converted to
-- @Nothing@.
--
-- Note that the parameter index starts at 1, not 0.
bindParameterName :: Statement -> ParamIndex -> IO (Maybe Text)
bindParameterName :: Statement -> ParamIndex -> IO (Maybe Text)
bindParameterName Statement
stmt ParamIndex
idx = do
    Maybe Utf8
m <- Statement -> ParamIndex -> IO (Maybe Utf8)
Direct.bindParameterName Statement
stmt ParamIndex
idx
    case Maybe Utf8
m of
        Maybe Utf8
Nothing   -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Just Utf8
name -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Utf8 -> IO Text
fromUtf8 String
desc Utf8
name
  where
    desc :: String
desc = String
"Database.SQLite3.bindParameterName: Invalid UTF-8"

-- | <https://www.sqlite.org/c3ref/column_name.html>
--
-- Return the name of a result column.  If the column index is out of range,
-- return 'Nothing'.
columnName :: Statement -> ColumnIndex -> IO (Maybe Text)
columnName :: Statement -> ColumnCount -> IO (Maybe Text)
columnName Statement
stmt ColumnCount
idx = do
    Maybe Utf8
m <- Statement -> ColumnCount -> IO (Maybe Utf8)
Direct.columnName Statement
stmt ColumnCount
idx
    case Maybe Utf8
m of
        Just Utf8
name -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Utf8 -> IO Text
fromUtf8 String
desc Utf8
name
        Maybe Utf8
Nothing -> do
            -- sqlite3_column_name only returns NULL if memory allocation fails
            -- or if the column index is out of range.
            ColumnCount
count <- Statement -> IO ColumnCount
Direct.columnCount Statement
stmt
            if ColumnCount
idx ColumnCount -> ColumnCount -> Bool
forall a. Ord a => a -> a -> Bool
>= ColumnCount
0 Bool -> Bool -> Bool
&& ColumnCount
idx ColumnCount -> ColumnCount -> Bool
forall a. Ord a => a -> a -> Bool
< ColumnCount
count
                then SQLError -> IO (Maybe Text)
forall e a. Exception e => e -> IO a
throwIO SQLError
outOfMemory
                else Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
  where
    desc :: String
desc = String
"Database.SQLite3.columnName: Invalid UTF-8"
    outOfMemory :: SQLError
outOfMemory = SQLError :: Error -> Text -> Text -> SQLError
SQLError
        { sqlError :: Error
sqlError        = Error
ErrorNoMemory
        , sqlErrorDetails :: Text
sqlErrorDetails = Text
"out of memory (sqlite3_column_name returned NULL)"
        , sqlErrorContext :: Text
sqlErrorContext = Text
"column name"
        }

bindBlob :: Statement -> ParamIndex -> ByteString -> IO ()
bindBlob :: Statement -> ParamIndex -> ByteString -> IO ()
bindBlob Statement
statement ParamIndex
parameterIndex ByteString
byteString =
    Statement -> ParamIndex -> ByteString -> IO (Either Error ())
Direct.bindBlob Statement
statement ParamIndex
parameterIndex ByteString
byteString
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"bind blob"

bindZeroBlob :: Statement -> ParamIndex -> Int -> IO ()
bindZeroBlob :: Statement -> ParamIndex -> Int -> IO ()
bindZeroBlob Statement
statement ParamIndex
parameterIndex Int
len =
    Statement -> ParamIndex -> Int -> IO (Either Error ())
Direct.bindZeroBlob Statement
statement ParamIndex
parameterIndex Int
len
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"bind zeroblob"

bindDouble :: Statement -> ParamIndex -> Double -> IO ()
bindDouble :: Statement -> ParamIndex -> Double -> IO ()
bindDouble Statement
statement ParamIndex
parameterIndex Double
datum =
    Statement -> ParamIndex -> Double -> IO (Either Error ())
Direct.bindDouble Statement
statement ParamIndex
parameterIndex Double
datum
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"bind double"

bindInt :: Statement -> ParamIndex -> Int -> IO ()
bindInt :: Statement -> ParamIndex -> Int -> IO ()
bindInt Statement
statement ParamIndex
parameterIndex Int
datum =
    Statement -> ParamIndex -> Int64 -> IO (Either Error ())
Direct.bindInt64 Statement
statement
                     ParamIndex
parameterIndex
                     (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
datum)
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"bind int"

bindInt64 :: Statement -> ParamIndex -> Int64 -> IO ()
bindInt64 :: Statement -> ParamIndex -> Int64 -> IO ()
bindInt64 Statement
statement ParamIndex
parameterIndex Int64
datum =
    Statement -> ParamIndex -> Int64 -> IO (Either Error ())
Direct.bindInt64 Statement
statement ParamIndex
parameterIndex Int64
datum
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"bind int64"

bindNull :: Statement -> ParamIndex -> IO ()
bindNull :: Statement -> ParamIndex -> IO ()
bindNull Statement
statement ParamIndex
parameterIndex =
    Statement -> ParamIndex -> IO (Either Error ())
Direct.bindNull Statement
statement ParamIndex
parameterIndex
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"bind null"

bindText :: Statement -> ParamIndex -> Text -> IO ()
bindText :: Statement -> ParamIndex -> Text -> IO ()
bindText Statement
statement ParamIndex
parameterIndex Text
text =
    Statement -> ParamIndex -> Utf8 -> IO (Either Error ())
Direct.bindText Statement
statement ParamIndex
parameterIndex (Text -> Utf8
toUtf8 Text
text)
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Statement -> DetailSource
DetailStatement Statement
statement) Text
"bind text"

-- | If the index is not between 1 and 'bindParameterCount' inclusive, this
-- fails with 'ErrorRange'.  Otherwise, it succeeds, even if the query skips
-- this index by using numbered parameters.
--
-- Example:
--
-- >> stmt <- prepare conn "SELECT ?1, ?3, ?5"
-- >> bindSQLData stmt 1 (SQLInteger 1)
-- >> bindSQLData stmt 2 (SQLInteger 2)
-- >> bindSQLData stmt 6 (SQLInteger 6)
-- >*** Exception: SQLite3 returned ErrorRange while attempting to perform bind int64.
-- >> step stmt >> columns stmt
-- >[SQLInteger 1,SQLNull,SQLNull]
bindSQLData :: Statement -> ParamIndex -> SQLData -> IO ()
bindSQLData :: Statement -> ParamIndex -> SQLData -> IO ()
bindSQLData Statement
statement ParamIndex
idx SQLData
datum =
    case SQLData
datum of
        SQLInteger Int64
v -> Statement -> ParamIndex -> Int64 -> IO ()
bindInt64  Statement
statement ParamIndex
idx Int64
v
        SQLFloat   Double
v -> Statement -> ParamIndex -> Double -> IO ()
bindDouble Statement
statement ParamIndex
idx Double
v
        SQLText    Text
v -> Statement -> ParamIndex -> Text -> IO ()
bindText   Statement
statement ParamIndex
idx Text
v
        SQLBlob    ByteString
v -> Statement -> ParamIndex -> ByteString -> IO ()
bindBlob   Statement
statement ParamIndex
idx ByteString
v
        SQLData
SQLNull      -> Statement -> ParamIndex -> IO ()
bindNull   Statement
statement ParamIndex
idx

-- | Convenience function for binding values to all parameters.  This will
-- 'fail' if the list has the wrong number of parameters.
bind :: Statement -> [SQLData] -> IO ()
bind :: Statement -> [SQLData] -> IO ()
bind Statement
statement [SQLData]
sqlData = do
    ParamIndex Int
nParams <- Statement -> IO ParamIndex
bindParameterCount Statement
statement
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nParams Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [SQLData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
sqlData) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"mismatched parameter count for bind.  Prepared statement "String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
"needs "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nParams String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([SQLData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
sqlData) String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" given")
    (ParamIndex -> SQLData -> IO ())
-> [ParamIndex] -> [SQLData] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Statement -> ParamIndex -> SQLData -> IO ()
bindSQLData Statement
statement) [ParamIndex
1..] [SQLData]
sqlData

-- | Convenience function for binding named values to all parameters.
-- This will 'fail' if the list has the wrong number of parameters or
-- if an unknown name is used.
--
-- Example:
--
-- @
-- stmt <- prepare conn \"SELECT :foo + :bar\"
-- bindNamed stmt [(\":foo\", SQLInteger 1), (\":bar\", SQLInteger 2)]
-- @
bindNamed :: Statement -> [(T.Text, SQLData)] -> IO ()
bindNamed :: Statement -> [(Text, SQLData)] -> IO ()
bindNamed Statement
statement [(Text, SQLData)]
params = do
    ParamIndex Int
nParams <- Statement -> IO ParamIndex
bindParameterCount Statement
statement
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nParams Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [(Text, SQLData)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, SQLData)]
params) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"mismatched parameter count for bind.  Prepared statement "String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
"needs "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nParams String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(Text, SQLData)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, SQLData)]
params) String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" given")
    ((Text, SQLData) -> IO ()) -> [(Text, SQLData)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, SQLData) -> IO ()
bindIdx [(Text, SQLData)]
params
    where
        bindIdx :: (Text, SQLData) -> IO ()
bindIdx (Text
name, SQLData
val) = do
            Maybe ParamIndex
idx <- Statement -> Utf8 -> IO (Maybe ParamIndex)
Direct.bindParameterIndex Statement
statement (Utf8 -> IO (Maybe ParamIndex)) -> Utf8 -> IO (Maybe ParamIndex)
forall a b. (a -> b) -> a -> b
$ Text -> Utf8
toUtf8 Text
name
            case Maybe ParamIndex
idx of
                Just ParamIndex
i ->
                    Statement -> ParamIndex -> SQLData -> IO ()
bindSQLData Statement
statement ParamIndex
i SQLData
val
                Maybe ParamIndex
Nothing ->
                    String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unknown named parameter "String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
name)

-- | This will throw a 'DecodeError' if the datum contains invalid UTF-8.
-- If this behavior is undesirable, you can use 'Direct.columnText' from
-- "Database.SQLite3.Direct", which does not perform conversion to 'Text'.
columnText :: Statement -> ColumnIndex -> IO Text
columnText :: Statement -> ColumnCount -> IO Text
columnText Statement
statement ColumnCount
columnIndex =
    Statement -> ColumnCount -> IO Utf8
Direct.columnText Statement
statement ColumnCount
columnIndex
        IO Utf8 -> (Utf8 -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Utf8 -> IO Text
fromUtf8 String
"Database.SQLite3.columnText: Invalid UTF-8"

column :: Statement -> ColumnIndex -> IO SQLData
column :: Statement -> ColumnCount -> IO SQLData
column Statement
statement ColumnCount
idx = do
    ColumnType
theType <- Statement -> ColumnCount -> IO ColumnType
columnType Statement
statement ColumnCount
idx
    ColumnType -> Statement -> ColumnCount -> IO SQLData
typedColumn ColumnType
theType Statement
statement ColumnCount
idx

columns :: Statement -> IO [SQLData]
columns :: Statement -> IO [SQLData]
columns Statement
statement = do
    ColumnCount
count <- Statement -> IO ColumnCount
columnCount Statement
statement
    (ColumnCount -> IO SQLData) -> [ColumnCount] -> IO [SQLData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Statement -> ColumnCount -> IO SQLData
column Statement
statement) [ColumnCount
0..ColumnCount
countColumnCount -> ColumnCount -> ColumnCount
forall a. Num a => a -> a -> a
-ColumnCount
1]

typedColumn :: ColumnType -> Statement -> ColumnIndex -> IO SQLData
typedColumn :: ColumnType -> Statement -> ColumnCount -> IO SQLData
typedColumn ColumnType
theType Statement
statement ColumnCount
idx = case ColumnType
theType of
    ColumnType
IntegerColumn -> Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> IO Int64 -> IO SQLData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnCount -> IO Int64
columnInt64  Statement
statement ColumnCount
idx
    ColumnType
FloatColumn   -> Double -> SQLData
SQLFloat   (Double -> SQLData) -> IO Double -> IO SQLData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnCount -> IO Double
columnDouble Statement
statement ColumnCount
idx
    ColumnType
TextColumn    -> Text -> SQLData
SQLText    (Text -> SQLData) -> IO Text -> IO SQLData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnCount -> IO Text
columnText   Statement
statement ColumnCount
idx
    ColumnType
BlobColumn    -> ByteString -> SQLData
SQLBlob    (ByteString -> SQLData) -> IO ByteString -> IO SQLData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnCount -> IO ByteString
columnBlob   Statement
statement ColumnCount
idx
    ColumnType
NullColumn    -> SQLData -> IO SQLData
forall (m :: * -> *) a. Monad m => a -> m a
return SQLData
SQLNull

-- | This avoids extra API calls using the list of column types.
-- If passed types do not correspond to the actual types, the values will be
-- converted according to the rules at <https://www.sqlite.org/c3ref/column_blob.html>.
-- If the list contains more items that number of columns, the result is undefined.
typedColumns :: Statement -> [Maybe ColumnType] -> IO [SQLData]
typedColumns :: Statement -> [Maybe ColumnType] -> IO [SQLData]
typedColumns Statement
statement = (ColumnCount -> Maybe ColumnType -> IO SQLData)
-> [ColumnCount] -> [Maybe ColumnType] -> IO [SQLData]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ColumnCount -> Maybe ColumnType -> IO SQLData
f [ColumnCount
0..] where
    f :: ColumnCount -> Maybe ColumnType -> IO SQLData
f ColumnCount
idx Maybe ColumnType
theType = case Maybe ColumnType
theType of
        Maybe ColumnType
Nothing -> Statement -> ColumnCount -> IO SQLData
column Statement
statement ColumnCount
idx
        Just ColumnType
t  -> ColumnType -> Statement -> ColumnCount -> IO SQLData
typedColumn ColumnType
t Statement
statement ColumnCount
idx

-- | <https://sqlite.org/c3ref/create_function.html>
--
-- Create a custom SQL function or redefine the behavior of an existing
-- function. If the function is deterministic, i.e. if it always returns the
-- same result given the same input, you can set the boolean flag to let
-- @sqlite@ perform additional optimizations.
createFunction
    :: Database
    -> Text           -- ^ Name of the function.
    -> Maybe ArgCount -- ^ Number of arguments. 'Nothing' means that the
                      --   function accepts any number of arguments.
    -> Bool           -- ^ Is the function deterministic?
    -> (FuncContext -> FuncArgs -> IO ())
                      -- ^ Implementation of the function.
    -> IO ()
createFunction :: Database
-> Text
-> Maybe ArgCount
-> Bool
-> (FuncContext -> FuncArgs -> IO ())
-> IO ()
createFunction Database
db Text
name Maybe ArgCount
nArgs Bool
isDet FuncContext -> FuncArgs -> IO ()
fun =
    Database
-> Utf8
-> Maybe ArgCount
-> Bool
-> (FuncContext -> FuncArgs -> IO ())
-> IO (Either Error ())
Direct.createFunction Database
db (Text -> Utf8
toUtf8 Text
name) Maybe ArgCount
nArgs Bool
isDet FuncContext -> FuncArgs -> IO ()
fun
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"createFunction " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
name)

-- | Like 'createFunction' except that it creates an aggregate function.
createAggregate
    :: Database
    -> Text           -- ^ Name of the function.
    -> Maybe ArgCount -- ^ Number of arguments.
    -> a              -- ^ Initial aggregate state.
    -> (FuncContext -> FuncArgs -> a -> IO a)
                      -- ^ Process one row and update the aggregate state.
    -> (FuncContext -> a -> IO ())
                      -- ^ Called after all rows have been processed.
                      --   Can be used to construct the returned value
                      --   from the aggregate state.
    -> IO ()
createAggregate :: Database
-> Text
-> Maybe ArgCount
-> a
-> (FuncContext -> FuncArgs -> a -> IO a)
-> (FuncContext -> a -> IO ())
-> IO ()
createAggregate Database
db Text
name Maybe ArgCount
nArgs a
initSt FuncContext -> FuncArgs -> a -> IO a
xStep FuncContext -> a -> IO ()
xFinal =
    Database
-> Utf8
-> Maybe ArgCount
-> a
-> (FuncContext -> FuncArgs -> a -> IO a)
-> (FuncContext -> a -> IO ())
-> IO (Either Error ())
forall a.
Database
-> Utf8
-> Maybe ArgCount
-> a
-> (FuncContext -> FuncArgs -> a -> IO a)
-> (FuncContext -> a -> IO ())
-> IO (Either Error ())
Direct.createAggregate Database
db (Text -> Utf8
toUtf8 Text
name) Maybe ArgCount
nArgs a
initSt FuncContext -> FuncArgs -> a -> IO a
xStep FuncContext -> a -> IO ()
xFinal
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"createAggregate " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
name)

-- | Delete an SQL function (scalar or aggregate).
deleteFunction :: Database -> Text -> Maybe ArgCount -> IO ()
deleteFunction :: Database -> Text -> Maybe ArgCount -> IO ()
deleteFunction Database
db Text
name Maybe ArgCount
nArgs =
    Database -> Utf8 -> Maybe ArgCount -> IO (Either Error ())
Direct.deleteFunction Database
db (Text -> Utf8
toUtf8 Text
name) Maybe ArgCount
nArgs
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"deleteFunction " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
name)

funcArgText :: FuncArgs -> ArgIndex -> IO Text
funcArgText :: FuncArgs -> ArgCount -> IO Text
funcArgText FuncArgs
args ArgCount
argIndex =
    FuncArgs -> ArgCount -> IO Utf8
Direct.funcArgText FuncArgs
args ArgCount
argIndex
        IO Utf8 -> (Utf8 -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Utf8 -> IO Text
fromUtf8 String
"Database.SQLite3.funcArgText: Invalid UTF-8"

funcResultSQLData :: FuncContext -> SQLData -> IO ()
funcResultSQLData :: FuncContext -> SQLData -> IO ()
funcResultSQLData FuncContext
ctx SQLData
datum =
    case SQLData
datum of
        SQLInteger Int64
v -> FuncContext -> Int64 -> IO ()
funcResultInt64  FuncContext
ctx Int64
v
        SQLFloat   Double
v -> FuncContext -> Double -> IO ()
funcResultDouble FuncContext
ctx Double
v
        SQLText    Text
v -> FuncContext -> Text -> IO ()
funcResultText   FuncContext
ctx Text
v
        SQLBlob    ByteString
v -> FuncContext -> ByteString -> IO ()
funcResultBlob   FuncContext
ctx ByteString
v
        SQLData
SQLNull      -> FuncContext -> IO ()
funcResultNull   FuncContext
ctx

funcResultText :: FuncContext -> Text -> IO ()
funcResultText :: FuncContext -> Text -> IO ()
funcResultText FuncContext
ctx Text
value =
    FuncContext -> Utf8 -> IO ()
Direct.funcResultText FuncContext
ctx (Text -> Utf8
toUtf8 Text
value)

-- | <https://www.sqlite.org/c3ref/create_collation.html>
createCollation
    :: Database
    -> Text                       -- ^ Name of the collation.
    -> (Text -> Text -> Ordering) -- ^ Comparison function.
    -> IO ()
createCollation :: Database -> Text -> (Text -> Text -> Ordering) -> IO ()
createCollation Database
db Text
name Text -> Text -> Ordering
cmp =
    Database
-> Utf8 -> (Utf8 -> Utf8 -> Ordering) -> IO (Either Error ())
Direct.createCollation Database
db (Text -> Utf8
toUtf8 Text
name) Utf8 -> Utf8 -> Ordering
cmp'
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"createCollation " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
name)
  where
    cmp' :: Utf8 -> Utf8 -> Ordering
cmp' (Utf8 ByteString
s1) (Utf8 ByteString
s2) = Text -> Text -> Ordering
cmp (ByteString -> Text
fromUtf8'' ByteString
s1) (ByteString -> Text
fromUtf8'' ByteString
s2)
    -- avoid throwing exceptions as much as possible
    fromUtf8'' :: ByteString -> Text
fromUtf8'' = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode

-- | Delete a collation.
deleteCollation :: Database -> Text -> IO ()
deleteCollation :: Database -> Text -> IO ()
deleteCollation Database
db Text
name =
    Database -> Utf8 -> IO (Either Error ())
Direct.deleteCollation Database
db (Text -> Utf8
toUtf8 Text
name)
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"deleteCollation " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
name)

-- | <https://www.sqlite.org/c3ref/blob_open.html>
--
-- Open a blob for incremental I/O.
blobOpen
    :: Database
    -> Text   -- ^ The symbolic name of the database (e.g. "main").
    -> Text   -- ^ The table name.
    -> Text   -- ^ The column name.
    -> Int64  -- ^ The @ROWID@ of the row.
    -> Bool   -- ^ Open the blob for read-write.
    -> IO Blob
blobOpen :: Database -> Text -> Text -> Text -> Int64 -> Bool -> IO Blob
blobOpen Database
db Text
zDb Text
zTable Text
zColumn Int64
rowid Bool
rw =
    Database
-> Utf8 -> Utf8 -> Utf8 -> Int64 -> Bool -> IO (Either Error Blob)
Direct.blobOpen Database
db (Text -> Utf8
toUtf8 Text
zDb) (Text -> Utf8
toUtf8 Text
zTable) (Text -> Utf8
toUtf8 Text
zColumn) Int64
rowid Bool
rw
        IO (Either Error Blob) -> (Either Error Blob -> IO Blob) -> IO Blob
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error Blob -> IO Blob
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) Text
"blobOpen"

-- | <https://www.sqlite.org/c3ref/blob_close.html>
blobClose :: Blob -> IO ()
blobClose :: Blob -> IO ()
blobClose blob :: Blob
blob@(Direct.Blob Database
db Ptr CBlob
_) =
    Blob -> IO (Either Error ())
Direct.blobClose Blob
blob
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) Text
"blobClose"

-- | <https://www.sqlite.org/c3ref/blob_reopen.html>
blobReopen
    :: Blob
    -> Int64 -- ^ The @ROWID@ of the row.
    -> IO ()
blobReopen :: Blob -> Int64 -> IO ()
blobReopen blob :: Blob
blob@(Direct.Blob Database
db Ptr CBlob
_) Int64
rowid =
    Blob -> Int64 -> IO (Either Error ())
Direct.blobReopen Blob
blob Int64
rowid
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) Text
"blobReopen"

-- | <https://www.sqlite.org/c3ref/blob_read.html>
blobRead
    :: Blob
    -> Int -- ^ Number of bytes to read.
    -> Int -- ^ Offset within the blob.
    -> IO ByteString
blobRead :: Blob -> Int -> Int -> IO ByteString
blobRead blob :: Blob
blob@(Direct.Blob Database
db Ptr CBlob
_) Int
len Int
offset =
    Blob -> Int -> Int -> IO (Either Error ByteString)
Direct.blobRead Blob
blob Int
len Int
offset
        IO (Either Error ByteString)
-> (Either Error ByteString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error ByteString -> IO ByteString
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) Text
"blobRead"

blobReadBuf :: Blob -> Ptr a -> Int -> Int -> IO ()
blobReadBuf :: Blob -> Ptr a -> Int -> Int -> IO ()
blobReadBuf blob :: Blob
blob@(Direct.Blob Database
db Ptr CBlob
_) Ptr a
buf Int
len Int
offset =
    Blob -> Ptr a -> Int -> Int -> IO (Either Error ())
forall a. Blob -> Ptr a -> Int -> Int -> IO (Either Error ())
Direct.blobReadBuf Blob
blob Ptr a
buf Int
len Int
offset
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) Text
"blobReadBuf"

-- | <https://www.sqlite.org/c3ref/blob_write.html>
blobWrite
    :: Blob
    -> ByteString
    -> Int -- ^ Offset within the blob.
    -> IO ()
blobWrite :: Blob -> ByteString -> Int -> IO ()
blobWrite blob :: Blob
blob@(Direct.Blob Database
db Ptr CBlob
_) ByteString
bs Int
offset =
    Blob -> ByteString -> Int -> IO (Either Error ())
Direct.blobWrite Blob
blob ByteString
bs Int
offset
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) Text
"blobWrite"

backupInit
    :: Database  -- ^ Destination database handle.
    -> Text      -- ^ Destination database name.
    -> Database  -- ^ Source database handle.
    -> Text      -- ^ Source database name.
    -> IO Backup
backupInit :: Database -> Text -> Database -> Text -> IO Backup
backupInit Database
dstDb Text
dstName Database
srcDb Text
srcName =
    Database -> Utf8 -> Database -> Utf8 -> IO (Either Error Backup)
Direct.backupInit Database
dstDb (Text -> Utf8
toUtf8 Text
dstName) Database
srcDb (Text -> Utf8
toUtf8 Text
srcName)
        IO (Either Error Backup)
-> (Either Error Backup -> IO Backup) -> IO Backup
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error Backup -> IO Backup
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
dstDb) Text
"backupInit"

backupFinish :: Backup -> IO ()
backupFinish :: Backup -> IO ()
backupFinish backup :: Backup
backup@(Direct.Backup Database
dstDb Ptr CBackup
_) =
    Backup -> IO (Either Error ())
Direct.backupFinish Backup
backup
        IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource -> Text -> Either Error () -> IO ()
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
dstDb) Text
"backupFinish"

backupStep :: Backup -> Int -> IO BackupStepResult
backupStep :: Backup -> Int -> IO BackupStepResult
backupStep Backup
backup Int
pages =
    Backup -> Int -> IO (Either Error BackupStepResult)
Direct.backupStep Backup
backup Int
pages
        -- it appears that sqlite does not generate an
        -- error message when sqlite3_backup_step fails
        IO (Either Error BackupStepResult)
-> (Either Error BackupStepResult -> IO BackupStepResult)
-> IO BackupStepResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DetailSource
-> Text -> Either Error BackupStepResult -> IO BackupStepResult
forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Utf8 -> DetailSource
DetailMessage Utf8
"failed") Text
"backupStep"