{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Database.SQLite3 (
    -- * Connection management
    open,
    open2,
    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(..),
    SQLOpenFlag(..),
    SQLVFS(..),
    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.Bits            ((.|.))
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)
import GHC.Generics

data SQLData
    = SQLInteger    !Int64
    | SQLFloat      !Double
    | SQLText       !Text
    | SQLBlob       !ByteString
    | SQLNull
    deriving (SQLData -> SQLData -> Bool
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SQLData] -> ShowS
$cshowList :: [SQLData] -> ShowS
show :: SQLData -> [Char]
$cshow :: SQLData -> [Char]
showsPrec :: Int -> SQLData -> ShowS
$cshowsPrec :: Int -> SQLData -> ShowS
Show, Typeable, forall x. Rep SQLData x -> SQLData
forall x. SQLData -> Rep SQLData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SQLData x -> SQLData
$cfrom :: forall x. SQLData -> Rep SQLData x
Generic)

-- | These flags are used when using the `open2` function.
-- <https://www.sqlite.org/c3ref/c_open_autoproxy.html>
data SQLOpenFlag
    = SQLOpenReadOnly      -- Ok for sqlite3_open_v2()
    | SQLOpenReadWrite     -- Ok for sqlite3_open_v2()
    | SQLOpenCreate        -- Ok for sqlite3_open_v2()
    | SQLOpenDeleteOnClose -- VFS only
    | SQLOpenExclusive     -- VFS only
    | SQLOpenAutoProxy     -- VFS only
    | SQLOpenURI           -- Ok for sqlite3_open_v2()
    | SQLOpenMemory        -- Ok for sqlite3_open_v2()
    | SQLOpenMainDB        -- VFS only
    | SQLOpenTempDB        -- VFS only
    | SQLOpenTransientDB   -- VFS only
    | SQLOpenMainJournal   -- VFS only
    | SQLOpenTempJournal   -- VFS only
    | SQLOpenSubJournal    -- VFS only
    | SQLOpenMasterJournal -- VFS only
    | SQLOpenNoMutex       -- Ok for sqlite3_open_v2()
    | SQLOpenFullMutex     -- Ok for sqlite3_open_v2()
    | SQLOpenSharedCache   -- Ok for sqlite3_open_v2()
    | SQLOpenPrivateCache  -- Ok for sqlite3_open_v2()
    | SQLOpenWAL           -- VFS only
    | SQLOpenNoFollow      -- Ok for sqlite3_open_v2()
    deriving (SQLOpenFlag -> SQLOpenFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SQLOpenFlag -> SQLOpenFlag -> Bool
$c/= :: SQLOpenFlag -> SQLOpenFlag -> Bool
== :: SQLOpenFlag -> SQLOpenFlag -> Bool
$c== :: SQLOpenFlag -> SQLOpenFlag -> Bool
Eq, Int -> SQLOpenFlag -> ShowS
[SQLOpenFlag] -> ShowS
SQLOpenFlag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SQLOpenFlag] -> ShowS
$cshowList :: [SQLOpenFlag] -> ShowS
show :: SQLOpenFlag -> [Char]
$cshow :: SQLOpenFlag -> [Char]
showsPrec :: Int -> SQLOpenFlag -> ShowS
$cshowsPrec :: Int -> SQLOpenFlag -> ShowS
Show)

-- | These VFS names are used when using the `open2` function.
data SQLVFS
    = SQLVFSDefault
    | SQLVFSUnix
    | SQLVFSUnixDotFile
    | SQLVFSUnixExcl
    | SQLVFSUnixNone
    | SQLVFSUnixNamedSem
    | SQLVFSCustom Text
    deriving (SQLVFS -> SQLVFS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SQLVFS -> SQLVFS -> Bool
$c/= :: SQLVFS -> SQLVFS -> Bool
== :: SQLVFS -> SQLVFS -> Bool
$c== :: SQLVFS -> SQLVFS -> Bool
Eq, Int -> SQLVFS -> ShowS
[SQLVFS] -> ShowS
SQLVFS -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SQLVFS] -> ShowS
$cshowList :: [SQLVFS] -> ShowS
show :: SQLVFS -> [Char]
$cshow :: SQLVFS -> [Char]
showsPrec :: Int -> SQLVFS -> ShowS
$cshowsPrec :: Int -> SQLVFS -> ShowS
Show)

-- | 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
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, forall x. Rep SQLError x -> SQLError
forall x. SQLError -> Rep SQLError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SQLError x -> SQLError
$cfrom :: forall x. SQLError -> Rep SQLError x
Generic)

-- 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 -> [Char]
show SQLError{ sqlError :: SQLError -> Error
sqlError        = Error
code
                 , sqlErrorDetails :: SQLError -> Text
sqlErrorDetails = Text
details
                 , sqlErrorContext :: SQLError -> Text
sqlErrorContext = Text
context
                 }
         = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
         [ Text
"SQLite3 returned "
         , [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
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 :: [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
desc Utf8
utf8 = forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ [Char] -> Utf8 -> Text
fromUtf8' [Char]
desc Utf8
utf8

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

toUtf8 :: Text -> Utf8
toUtf8 :: Text -> Utf8
toUtf8 = ByteString -> Utf8
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 ->
        forall (m :: * -> *) a. Monad m => a -> m a
return Utf8
msg

throwSQLError :: DetailSource -> Text -> Error -> IO a
throwSQLError :: forall a. DetailSource -> Text -> Error -> IO a
throwSQLError DetailSource
detailSource Text
context Error
error = do
    Utf8 ByteString
details <- DetailSource -> IO Utf8
renderDetailSource DetailSource
detailSource
    forall e a. Exception e => e -> IO a
throwIO 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 :: forall a. DetailSource -> Text -> Either Error a -> IO a
checkError DetailSource
ds Text
fn = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. DetailSource -> Text -> Error -> IO a
throwSQLError DetailSource
ds Text
fn) forall (m :: * -> *) a. Monad m => a -> m a
return

checkErrorMsg :: Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg :: forall a. 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) -> forall a. DetailSource -> Text -> Error -> IO a
throwSQLError (Utf8 -> DetailSource
DetailMessage Utf8
msg) Text
fn Error
err
    Right a
a         -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a

appendShow :: Show a => Text -> a -> Text
appendShow :: forall a. Show a => Text -> a -> Text
appendShow Text
txt a
a = Text
txt Text -> Text -> Text
`T.append` ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
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)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg (Text
"open " forall a. Show a => Text -> a -> Text
`appendShow` Text
path)

-- | <https://www.sqlite.org/c3ref/open.html>
open2 :: Text -> [SQLOpenFlag] -> SQLVFS -> IO Database
open2 :: Text -> [SQLOpenFlag] -> SQLVFS -> IO Database
open2 Text
path [SQLOpenFlag]
flags SQLVFS
zvfs =
    Utf8 -> Int -> Maybe Utf8 -> IO (Either (Error, Utf8) Database)
Direct.open2 (Text -> Utf8
toUtf8 Text
path) ([SQLOpenFlag] -> Int
makeFlag [SQLOpenFlag]
flags) (SQLVFS -> Maybe Utf8
toMUtf8 SQLVFS
zvfs)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg (Text
"open2 " forall a. Show a => Text -> a -> Text
`appendShow` Text
path)
    where
        toMUtf8 :: SQLVFS -> Maybe Utf8
toMUtf8 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Utf8
toUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLVFS -> Maybe Text
toMText

        toMText :: SQLVFS -> Maybe Text
toMText SQLVFS
SQLVFSDefault           = forall a. Maybe a
Nothing
        toMText SQLVFS
SQLVFSUnix              = forall a. a -> Maybe a
Just Text
"unix"
        toMText SQLVFS
SQLVFSUnixDotFile       = forall a. a -> Maybe a
Just Text
"unix-dotfile"
        toMText SQLVFS
SQLVFSUnixExcl          = forall a. a -> Maybe a
Just Text
"unix-excl"
        toMText SQLVFS
SQLVFSUnixNone          = forall a. a -> Maybe a
Just Text
"unix-none"
        toMText SQLVFS
SQLVFSUnixNamedSem      = forall a. a -> Maybe a
Just Text
"unix-namedsem"
        toMText (SQLVFSCustom Text
custom)   = forall a. a -> Maybe a
Just Text
custom

        makeFlag :: [SQLOpenFlag] -> Int
makeFlag = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Num a => SQLOpenFlag -> a
toNum

        toNum :: SQLOpenFlag -> a
toNum SQLOpenFlag
SQLOpenReadOnly       = a
0x00000001
        toNum SQLOpenFlag
SQLOpenReadWrite      = a
0x00000002
        toNum SQLOpenFlag
SQLOpenCreate         = a
0x00000004
        toNum SQLOpenFlag
SQLOpenDeleteOnClose  = a
0x00000008
        toNum SQLOpenFlag
SQLOpenExclusive      = a
0x00000010
        toNum SQLOpenFlag
SQLOpenAutoProxy      = a
0x00000020
        toNum SQLOpenFlag
SQLOpenURI            = a
0x00000040
        toNum SQLOpenFlag
SQLOpenMemory         = a
0x00000080
        toNum SQLOpenFlag
SQLOpenMainDB         = a
0x00000100
        toNum SQLOpenFlag
SQLOpenTempDB         = a
0x00000200
        toNum SQLOpenFlag
SQLOpenTransientDB    = a
0x00000400
        toNum SQLOpenFlag
SQLOpenMainJournal    = a
0x00000800
        toNum SQLOpenFlag
SQLOpenTempJournal    = a
0x00001000
        toNum SQLOpenFlag
SQLOpenSubJournal     = a
0x00002000
        toNum SQLOpenFlag
SQLOpenMasterJournal  = a
0x00004000
        toNum SQLOpenFlag
SQLOpenNoMutex        = a
0x00008000
        toNum SQLOpenFlag
SQLOpenFullMutex      = a
0x00010000
        toNum SQLOpenFlag
SQLOpenSharedCache    = a
0x00020000
        toNum SQLOpenFlag
SQLOpenPrivateCache   = a
0x00040000
        toNum SQLOpenFlag
SQLOpenWAL            = a
0x00080000
        toNum SQLOpenFlag
SQLOpenNoFollow       = a
0x01000000

-- | <https://www.sqlite.org/c3ref/close.html>
close :: Database -> IO ()
close :: Database -> IO ()
close Database
db =
    Database -> IO (Either Error ())
Direct.close Database
db forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
interruptibly :: forall a. Database -> IO a -> IO a
interruptibly Database
db IO a
io
  | Bool
rtsSupportsBoundThreads =
      forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
          MVar (Either SomeException a)
mv <- forall a. IO (MVar a)
newEmptyMVar
          ThreadId
tid <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Either SomeException a)
try' (forall a. IO a -> IO a
restore IO a
io) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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.
                  forall a. IO a -> IO a
uninterruptibleMask_ 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
_ <- forall a. MVar a -> IO a
takeMVar MVar (Either SomeException a)
mv
                      forall (m :: * -> *) a. Monad m => a -> m a
return ()

          Either SomeException a
e <- forall a. MVar a -> IO a
takeMVar MVar (Either SomeException a)
mv forall a b. IO a -> IO b -> IO a
`onException` IO ()
interruptAndWait
          forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO 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' :: forall a. IO a -> IO (Either SomeException a)
try' = forall e a. Exception e => IO a -> IO (Either e a)
try

-- | 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)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg (Text
"exec " 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 =
    forall a. Database -> IO a -> IO a
interruptibly Database
db forall a b. (a -> b) -> a -> b
$
    Database -> Text -> ExecCallback -> IO ()
execWithCallback Database
db Text
sql forall a b. (a -> b) -> a -> b
$ \ColumnIndex
_count [Text]
_colnames -> Text -> IO ()
T.putStrLn 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
"|" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (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'
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Text -> Either (Error, Utf8) a -> IO a
checkErrorMsg (Text
"execWithCallback " forall a. Show a => Text -> a -> Text
`appendShow` Text
sql)
  where
    -- We want 'names' computed once and shared with every call.
    cb' :: ExecCallback
cb' ColumnIndex
count [Utf8]
namesUtf8 =
       let names :: [Text]
names = forall a b. (a -> b) -> [a] -> [b]
map Utf8 -> Text
fromUtf8'' [Utf8]
namesUtf8
           {-# NOINLINE names #-}
        in ExecCallback
cb ColumnIndex
count [Text]
names forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Utf8 -> Text
fromUtf8'')

    fromUtf8'' :: Utf8 -> Text
fromUtf8'' = [Char] -> Utf8 -> Text
fromUtf8' [Char]
"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
            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"prepare " forall a. Show a => Text -> a -> Text
`appendShow` Utf8
sql)
    case Maybe Statement
m of
        Maybe Statement
Nothing   -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Direct.SQLite3.prepare: empty query string"
        Just Statement
stmt -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
    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
    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   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just Utf8
name -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
desc Utf8
name
  where
    desc :: [Char]
desc = [Char]
"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 -> ColumnIndex -> IO (Maybe Text)
columnName Statement
stmt ColumnIndex
idx = do
    Maybe Utf8
m <- Statement -> ColumnIndex -> IO (Maybe Utf8)
Direct.columnName Statement
stmt ColumnIndex
idx
    case Maybe Utf8
m of
        Just Utf8
name -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
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.
            ColumnIndex
count <- Statement -> IO ColumnIndex
Direct.columnCount Statement
stmt
            if ColumnIndex
idx forall a. Ord a => a -> a -> Bool
>= ColumnIndex
0 Bool -> Bool -> Bool
&& ColumnIndex
idx forall a. Ord a => a -> a -> Bool
< ColumnIndex
count
                then forall e a. Exception e => e -> IO a
throwIO SQLError
outOfMemory
                else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  where
    desc :: [Char]
desc = [Char]
"Database.SQLite3.columnName: Invalid UTF-8"
    outOfMemory :: SQLError
outOfMemory = 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
                     (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
datum)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nParams forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
sqlData) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"mismatched parameter count for bind.  Prepared statement "forall a. [a] -> [a] -> [a]
++
              [Char]
"needs "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
nParams forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
sqlData) forall a. [a] -> [a] -> [a]
++[Char]
" given")
    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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nParams forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, SQLData)]
params) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"mismatched parameter count for bind.  Prepared statement "forall a. [a] -> [a] -> [a]
++
              [Char]
"needs "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
nParams forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, SQLData)]
params) forall a. [a] -> [a] -> [a]
++[Char]
" given")
    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 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 ->
                    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"unknown named parameter "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
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 -> ColumnIndex -> IO Text
columnText Statement
statement ColumnIndex
columnIndex =
    Statement -> ColumnIndex -> IO Utf8
Direct.columnText Statement
statement ColumnIndex
columnIndex
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
"Database.SQLite3.columnText: Invalid UTF-8"

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

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

typedColumn :: ColumnType -> Statement -> ColumnIndex -> IO SQLData
typedColumn :: ColumnType -> Statement -> ColumnIndex -> IO SQLData
typedColumn ColumnType
theType Statement
statement ColumnIndex
idx = case ColumnType
theType of
    ColumnType
IntegerColumn -> Int64 -> SQLData
SQLInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO Int64
columnInt64  Statement
statement ColumnIndex
idx
    ColumnType
FloatColumn   -> Double -> SQLData
SQLFloat   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO Double
columnDouble Statement
statement ColumnIndex
idx
    ColumnType
TextColumn    -> Text -> SQLData
SQLText    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO Text
columnText   Statement
statement ColumnIndex
idx
    ColumnType
BlobColumn    -> ByteString -> SQLData
SQLBlob    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO ByteString
columnBlob   Statement
statement ColumnIndex
idx
    ColumnType
NullColumn    -> 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 = forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ColumnIndex -> Maybe ColumnType -> IO SQLData
f [ColumnIndex
0..] where
    f :: ColumnIndex -> Maybe ColumnType -> IO SQLData
f ColumnIndex
idx Maybe ColumnType
theType = case Maybe ColumnType
theType of
        Maybe ColumnType
Nothing -> Statement -> ColumnIndex -> IO SQLData
column Statement
statement ColumnIndex
idx
        Just ColumnType
t  -> ColumnType -> Statement -> ColumnIndex -> IO SQLData
typedColumn ColumnType
t Statement
statement ColumnIndex
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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"createFunction " 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 :: forall a.
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 =
    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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"createAggregate " 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"deleteFunction " 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
"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'
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"createCollation " 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)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Database -> DetailSource
DetailDatabase Database
db) (Text
"deleteCollation " 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 :: forall a. Blob -> Ptr a -> Int -> Int -> IO ()
blobReadBuf blob :: Blob
blob@(Direct.Blob Database
db Ptr CBlob
_) Ptr a
buf Int
len Int
offset =
    forall a. Blob -> Ptr a -> Int -> Int -> IO (Either Error ())
Direct.blobReadBuf Blob
blob Ptr a
buf Int
len Int
offset
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DetailSource -> Text -> Either Error a -> IO a
checkError (Utf8 -> DetailSource
DetailMessage Utf8
"failed") Text
"backupStep"