{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Database.SQLite3 (
withDatabase,
open,
open2,
close,
exec,
execPrint,
execWithCallback,
ExecCallback,
withStatement,
prepare,
prepareUtf8,
step,
stepNoCB,
reset,
finalize,
clearBindings,
bindParameterCount,
bindParameterName,
columnCount,
columnName,
bindSQLData,
bind,
bindNamed,
bindInt,
bindInt64,
bindDouble,
bindText,
bindBlob,
bindZeroBlob,
bindNull,
column,
columns,
typedColumns,
columnType,
columnInt64,
columnDouble,
columnText,
columnBlob,
lastInsertRowId,
changes,
createFunction,
createAggregate,
deleteFunction,
funcArgCount,
funcArgType,
funcArgInt64,
funcArgDouble,
funcArgText,
funcArgBlob,
funcResultSQLData,
funcResultInt64,
funcResultDouble,
funcResultText,
funcResultBlob,
funcResultZeroBlob,
funcResultNull,
getFuncContextDatabase,
createCollation,
deleteCollation,
interrupt,
interruptibly,
blobOpen,
blobClose,
blobReopen,
blobBytes,
blobRead,
blobReadBuf,
blobWrite,
backupInit,
backupFinish,
backupStep,
backupRemaining,
backupPagecount,
Database,
Statement,
SQLData(..),
SQLOpenFlag(..),
SQLVFS(..),
SQLError(..),
ColumnType(..),
FuncContext,
FuncArgs,
Blob,
Backup,
StepResult(..),
BackupStepResult(..),
Error(..),
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
, 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
(SQLData -> SQLData -> Bool)
-> (SQLData -> SQLData -> Bool) -> Eq SQLData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLData -> SQLData -> Bool
== :: SQLData -> SQLData -> Bool
$c/= :: SQLData -> SQLData -> Bool
/= :: SQLData -> SQLData -> Bool
Eq, Int -> SQLData -> ShowS
[SQLData] -> ShowS
SQLData -> [Char]
(Int -> SQLData -> ShowS)
-> (SQLData -> [Char]) -> ([SQLData] -> ShowS) -> Show SQLData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQLData -> ShowS
showsPrec :: Int -> SQLData -> ShowS
$cshow :: SQLData -> [Char]
show :: SQLData -> [Char]
$cshowList :: [SQLData] -> ShowS
showList :: [SQLData] -> ShowS
Show, Typeable, (forall x. SQLData -> Rep SQLData x)
-> (forall x. Rep SQLData x -> SQLData) -> Generic SQLData
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
$cfrom :: forall x. SQLData -> Rep SQLData x
from :: forall x. SQLData -> Rep SQLData x
$cto :: forall x. Rep SQLData x -> SQLData
to :: forall x. Rep SQLData x -> SQLData
Generic)
data SQLOpenFlag
= SQLOpenReadOnly
| SQLOpenReadWrite
| SQLOpenCreate
| SQLOpenDeleteOnClose
| SQLOpenExclusive
| SQLOpenAutoProxy
| SQLOpenURI
| SQLOpenMemory
| SQLOpenMainDB
| SQLOpenTempDB
| SQLOpenTransientDB
| SQLOpenMainJournal
| SQLOpenTempJournal
| SQLOpenSubJournal
| SQLOpenMasterJournal
| SQLOpenNoMutex
| SQLOpenFullMutex
| SQLOpenSharedCache
| SQLOpenPrivateCache
| SQLOpenWAL
| SQLOpenNoFollow
| SQLOpenExResCode
deriving (SQLOpenFlag -> SQLOpenFlag -> Bool
(SQLOpenFlag -> SQLOpenFlag -> Bool)
-> (SQLOpenFlag -> SQLOpenFlag -> Bool) -> Eq SQLOpenFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLOpenFlag -> SQLOpenFlag -> Bool
== :: SQLOpenFlag -> SQLOpenFlag -> Bool
$c/= :: SQLOpenFlag -> SQLOpenFlag -> Bool
/= :: SQLOpenFlag -> SQLOpenFlag -> Bool
Eq, Int -> SQLOpenFlag -> ShowS
[SQLOpenFlag] -> ShowS
SQLOpenFlag -> [Char]
(Int -> SQLOpenFlag -> ShowS)
-> (SQLOpenFlag -> [Char])
-> ([SQLOpenFlag] -> ShowS)
-> Show SQLOpenFlag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQLOpenFlag -> ShowS
showsPrec :: Int -> SQLOpenFlag -> ShowS
$cshow :: SQLOpenFlag -> [Char]
show :: SQLOpenFlag -> [Char]
$cshowList :: [SQLOpenFlag] -> ShowS
showList :: [SQLOpenFlag] -> ShowS
Show)
data SQLVFS
= SQLVFSDefault
| SQLVFSUnix
| SQLVFSUnixDotFile
| SQLVFSUnixExcl
| SQLVFSUnixNone
| SQLVFSUnixNamedSem
| SQLVFSCustom Text
deriving (SQLVFS -> SQLVFS -> Bool
(SQLVFS -> SQLVFS -> Bool)
-> (SQLVFS -> SQLVFS -> Bool) -> Eq SQLVFS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLVFS -> SQLVFS -> Bool
== :: SQLVFS -> SQLVFS -> Bool
$c/= :: SQLVFS -> SQLVFS -> Bool
/= :: SQLVFS -> SQLVFS -> Bool
Eq, Int -> SQLVFS -> ShowS
[SQLVFS] -> ShowS
SQLVFS -> [Char]
(Int -> SQLVFS -> ShowS)
-> (SQLVFS -> [Char]) -> ([SQLVFS] -> ShowS) -> Show SQLVFS
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQLVFS -> ShowS
showsPrec :: Int -> SQLVFS -> ShowS
$cshow :: SQLVFS -> [Char]
show :: SQLVFS -> [Char]
$cshowList :: [SQLVFS] -> ShowS
showList :: [SQLVFS] -> ShowS
Show)
data SQLError = SQLError
{ SQLError -> Error
sqlError :: !Error
, SQLError -> Text
sqlErrorDetails :: Text
, SQLError -> Text
sqlErrorContext :: Text
}
deriving (SQLError -> SQLError -> Bool
(SQLError -> SQLError -> Bool)
-> (SQLError -> SQLError -> Bool) -> Eq SQLError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLError -> SQLError -> Bool
== :: SQLError -> SQLError -> Bool
$c/= :: SQLError -> SQLError -> Bool
/= :: SQLError -> SQLError -> Bool
Eq, Typeable, (forall x. SQLError -> Rep SQLError x)
-> (forall x. Rep SQLError x -> SQLError) -> Generic SQLError
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
$cfrom :: forall x. SQLError -> Rep SQLError x
from :: forall x. SQLError -> Rep SQLError x
$cto :: forall x. Rep SQLError x -> SQLError
to :: forall x. Rep SQLError x -> SQLError
Generic)
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 (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
[ Text
"SQLite3 returned "
, [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Error -> [Char]
forall a. Show a => a -> [Char]
show Error
code
, Text
" while attempting to perform "
, Text
context
, Text
": "
, Text
details
]
instance Exception SQLError
fromUtf8 :: String -> Utf8 -> IO Text
fromUtf8 :: [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
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
$ [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 -> UnicodeException -> Maybe Char
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 (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 a. a -> IO a
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
SQLError -> IO a
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 = (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 a. a -> IO a
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) -> 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 a. a -> IO 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 ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show) a
a
withDatabase :: Text
-> (Database -> IO a)
-> IO a
withDatabase :: forall a. Text -> (Database -> IO a) -> IO a
withDatabase Text
path = IO Database -> (Database -> IO ()) -> (Database -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Text -> IO Database
open Text
path) Database -> IO ()
close
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 a b. IO a -> (a -> IO b) -> IO b
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)
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)
IO (Either (Error, Utf8) Database)
-> (Either (Error, Utf8) Database -> IO Database) -> IO Database
forall a b. IO a -> (a -> IO b) -> IO b
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
"open2 " Text -> Text -> Text
forall a. Show a => Text -> a -> Text
`appendShow` Text
path)
where
toMUtf8 :: SQLVFS -> Maybe Utf8
toMUtf8 = (Text -> Utf8) -> Maybe Text -> Maybe Utf8
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Utf8
toUtf8 (Maybe Text -> Maybe Utf8)
-> (SQLVFS -> Maybe Text) -> SQLVFS -> Maybe Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLVFS -> Maybe Text
toMText
toMText :: SQLVFS -> Maybe Text
toMText SQLVFS
SQLVFSDefault = Maybe Text
forall a. Maybe a
Nothing
toMText SQLVFS
SQLVFSUnix = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"unix"
toMText SQLVFS
SQLVFSUnixDotFile = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"unix-dotfile"
toMText SQLVFS
SQLVFSUnixExcl = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"unix-excl"
toMText SQLVFS
SQLVFSUnixNone = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"unix-none"
toMText SQLVFS
SQLVFSUnixNamedSem = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"unix-namedsem"
toMText (SQLVFSCustom Text
custom) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
custom
makeFlag :: [SQLOpenFlag] -> Int
makeFlag = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
0 ([Int] -> Int) -> ([SQLOpenFlag] -> [Int]) -> [SQLOpenFlag] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SQLOpenFlag -> Int) -> [SQLOpenFlag] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SQLOpenFlag -> Int
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
toNum SQLOpenFlag
SQLOpenExResCode = a
0x02000000
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 a b. IO a -> (a -> IO b) -> IO b
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"
interruptibly :: Database -> IO a -> IO a
interruptibly :: forall a. 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 a b. IO a -> (a -> IO b) -> IO b
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 =
IO () -> IO ()
forall a. IO a -> IO a
uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Database -> IO ()
interrupt Database
db
ThreadId -> IO ()
killThread ThreadId
tid
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 a. a -> IO a
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 a. 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' :: forall a. 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
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 a b. IO a -> (a -> IO b) -> IO b
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)
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
$ \ColumnIndex
_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
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
"")
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 a b. IO a -> (a -> IO b) -> IO b
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
cb' :: ExecCallback
cb' ColumnIndex
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 ColumnIndex
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 a b. (a -> b) -> Maybe a -> Maybe b
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
-> [Text]
-> [Maybe Text]
-> IO ()
withStatement :: Database
-> Text
-> (Statement -> IO a)
-> IO a
withStatement :: forall a. Database -> Text -> (Statement -> IO a) -> IO a
withStatement Database
db Text
sql = IO Statement -> (Statement -> IO ()) -> (Statement -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Database -> Text -> IO Statement
prepare Database
db Text
sql) Statement -> IO ()
finalize
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)
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 a b. IO a -> (a -> IO b) -> IO b
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 -> [Char] -> IO Statement
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Direct.SQLite3.prepare: empty query string"
Just Statement
stmt -> Statement -> IO Statement
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
stmt
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 a b. IO a -> (a -> IO b) -> IO b
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"
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 a b. IO a -> (a -> IO b) -> IO b
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"
reset :: Statement -> IO ()
reset :: Statement -> IO ()
reset Statement
statement = do
Either Error ()
_ <- Statement -> IO (Either Error ())
Direct.reset Statement
statement
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
finalize :: Statement -> IO ()
finalize :: Statement -> IO ()
finalize Statement
statement = do
Either Error ()
_ <- Statement -> IO (Either Error ())
Direct.finalize Statement
statement
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 a. a -> IO a
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
<$> [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
desc Utf8
name
where
desc :: [Char]
desc = [Char]
"Database.SQLite3.bindParameterName: Invalid UTF-8"
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 -> 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
<$> [Char] -> Utf8 -> IO Text
fromUtf8 [Char]
desc Utf8
name
Maybe Utf8
Nothing -> do
ColumnIndex
count <- Statement -> IO ColumnIndex
Direct.columnCount Statement
stmt
if ColumnIndex
idx ColumnIndex -> ColumnIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= ColumnIndex
0 Bool -> Bool -> Bool
&& ColumnIndex
idx ColumnIndex -> ColumnIndex -> Bool
forall a. Ord a => a -> a -> Bool
< ColumnIndex
count
then SQLError -> IO (Maybe Text)
forall e a. Exception e => e -> IO a
throwIO SQLError
outOfMemory
else Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
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
IO (Either Error ()) -> (Either Error () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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"
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
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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
sqlData) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"mismatched parameter count for bind. Prepared statement "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
"needs "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
nParams [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([SQLData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
sqlData) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" 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
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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, SQLData)]
params) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"mismatched parameter count for bind. Prepared statement "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
"needs "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
nParams [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([(Text, SQLData)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, SQLData)]
params) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" 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 ->
[Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"unknown named parameter "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name)
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
IO Utf8 -> (Utf8 -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
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
(ColumnIndex -> IO SQLData) -> [ColumnIndex] -> IO [SQLData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Statement -> ColumnIndex -> IO SQLData
column Statement
statement) [ColumnIndex
0..ColumnIndex
countColumnIndex -> ColumnIndex -> ColumnIndex
forall 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 (Int64 -> SQLData) -> IO Int64 -> IO SQLData
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 (Double -> SQLData) -> IO Double -> IO SQLData
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 (Text -> SQLData) -> IO Text -> IO SQLData
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 (ByteString -> SQLData) -> IO ByteString -> IO SQLData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> ColumnIndex -> IO ByteString
columnBlob Statement
statement ColumnIndex
idx
ColumnType
NullColumn -> SQLData -> IO SQLData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SQLData
SQLNull
typedColumns :: Statement -> [Maybe ColumnType] -> IO [SQLData]
typedColumns :: Statement -> [Maybe ColumnType] -> IO [SQLData]
typedColumns Statement
statement = (ColumnIndex -> Maybe ColumnType -> IO SQLData)
-> [ColumnIndex] -> [Maybe ColumnType] -> IO [SQLData]
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
createFunction
:: Database
-> Text
-> Maybe ArgCount
-> Bool
-> (FuncContext -> FuncArgs -> IO ())
-> 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 a b. IO a -> (a -> IO b) -> IO b
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)
createAggregate
:: Database
-> Text
-> Maybe ArgCount
-> a
-> (FuncContext -> FuncArgs -> a -> IO a)
-> (FuncContext -> a -> IO ())
-> 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 =
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 a b. IO a -> (a -> IO b) -> IO b
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)
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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)
createCollation
:: Database
-> Text
-> (Text -> Text -> Ordering)
-> 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 a b. IO a -> (a -> IO b) -> IO b
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)
fromUtf8'' :: ByteString -> Text
fromUtf8'' = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
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 a b. IO a -> (a -> IO b) -> IO b
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)
blobOpen
:: Database
-> Text
-> Text
-> Text
-> Int64
-> Bool
-> 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 a b. IO a -> (a -> IO b) -> IO b
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"
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 a b. IO a -> (a -> IO b) -> IO b
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"
blobReopen
:: Blob
-> Int64
-> 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 a b. IO a -> (a -> IO b) -> IO b
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"
blobRead
:: Blob
-> Int
-> Int
-> 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 a b. IO a -> (a -> IO b) -> IO b
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 :: 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 =
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 a b. IO a -> (a -> IO b) -> IO b
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"
blobWrite
:: Blob
-> ByteString
-> Int
-> 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 a b. IO a -> (a -> IO b) -> IO b
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
-> Text
-> Database
-> Text
-> 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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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
IO (Either Error BackupStepResult)
-> (Either Error BackupStepResult -> IO BackupStepResult)
-> IO BackupStepResult
forall a b. IO a -> (a -> IO b) -> IO b
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"