{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables, GADTs #-}
module Database.SQLite.Simple (
Query(..)
, Connection(..)
, ToRow(..)
, FromRow(..)
, Only(..)
, (:.)(..)
, Base.SQLData(..)
, Statement(..)
, ColumnIndex(..)
, NamedParam(..)
, open
, close
, withConnection
, setTrace
, query
, query_
, queryWith
, queryWith_
, queryNamed
, lastInsertRowId
, changes
, totalChanges
, fold
, fold_
, foldNamed
, execute
, execute_
, executeMany
, executeNamed
, field
, withTransaction
, withImmediateTransaction
, withExclusiveTransaction
, withSavepoint
, openStatement
, closeStatement
, withStatement
, bind
, bindNamed
, reset
, columnName
, columnCount
, withBind
, nextRow
, FormatError(..)
, ResultError(..)
, Base.SQLError(..)
, Base.Error(..)
) where
import Control.Exception
import Control.Monad (void, when, forM_)
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Strict
import Data.Int (Int64)
import Data.IORef
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Typeable (Typeable)
import Database.SQLite.Simple.Types
import qualified Database.SQLite3 as Base
import qualified Database.SQLite3.Direct as BaseD
import Database.SQLite.Simple.FromField (ResultError(..))
import Database.SQLite.Simple.FromRow
import Database.SQLite.Simple.Internal
import Database.SQLite.Simple.Ok
import Database.SQLite.Simple.ToField (ToField(..))
import Database.SQLite.Simple.ToRow (ToRow(..))
newtype Statement = Statement { Statement -> Statement
unStatement :: Base.Statement }
newtype ColumnIndex = ColumnIndex BaseD.ColumnIndex
deriving (ColumnIndex -> ColumnIndex -> Bool
(ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool) -> Eq ColumnIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnIndex -> ColumnIndex -> Bool
== :: ColumnIndex -> ColumnIndex -> Bool
$c/= :: ColumnIndex -> ColumnIndex -> Bool
/= :: ColumnIndex -> ColumnIndex -> Bool
Eq, Eq ColumnIndex
Eq ColumnIndex =>
(ColumnIndex -> ColumnIndex -> Ordering)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> Bool)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> Ord ColumnIndex
ColumnIndex -> ColumnIndex -> Bool
ColumnIndex -> ColumnIndex -> Ordering
ColumnIndex -> ColumnIndex -> ColumnIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ColumnIndex -> ColumnIndex -> Ordering
compare :: ColumnIndex -> ColumnIndex -> Ordering
$c< :: ColumnIndex -> ColumnIndex -> Bool
< :: ColumnIndex -> ColumnIndex -> Bool
$c<= :: ColumnIndex -> ColumnIndex -> Bool
<= :: ColumnIndex -> ColumnIndex -> Bool
$c> :: ColumnIndex -> ColumnIndex -> Bool
> :: ColumnIndex -> ColumnIndex -> Bool
$c>= :: ColumnIndex -> ColumnIndex -> Bool
>= :: ColumnIndex -> ColumnIndex -> Bool
$cmax :: ColumnIndex -> ColumnIndex -> ColumnIndex
max :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cmin :: ColumnIndex -> ColumnIndex -> ColumnIndex
min :: ColumnIndex -> ColumnIndex -> ColumnIndex
Ord, Int -> ColumnIndex
ColumnIndex -> Int
ColumnIndex -> [ColumnIndex]
ColumnIndex -> ColumnIndex
ColumnIndex -> ColumnIndex -> [ColumnIndex]
ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
(ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (Int -> ColumnIndex)
-> (ColumnIndex -> Int)
-> (ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex])
-> Enum ColumnIndex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ColumnIndex -> ColumnIndex
succ :: ColumnIndex -> ColumnIndex
$cpred :: ColumnIndex -> ColumnIndex
pred :: ColumnIndex -> ColumnIndex
$ctoEnum :: Int -> ColumnIndex
toEnum :: Int -> ColumnIndex
$cfromEnum :: ColumnIndex -> Int
fromEnum :: ColumnIndex -> Int
$cenumFrom :: ColumnIndex -> [ColumnIndex]
enumFrom :: ColumnIndex -> [ColumnIndex]
$cenumFromThen :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromThen :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
$cenumFromTo :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromTo :: ColumnIndex -> ColumnIndex -> [ColumnIndex]
$cenumFromThenTo :: ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
enumFromThenTo :: ColumnIndex -> ColumnIndex -> ColumnIndex -> [ColumnIndex]
Enum, Integer -> ColumnIndex
ColumnIndex -> ColumnIndex
ColumnIndex -> ColumnIndex -> ColumnIndex
(ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex)
-> (Integer -> ColumnIndex)
-> Num ColumnIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ColumnIndex -> ColumnIndex -> ColumnIndex
+ :: ColumnIndex -> ColumnIndex -> ColumnIndex
$c- :: ColumnIndex -> ColumnIndex -> ColumnIndex
- :: ColumnIndex -> ColumnIndex -> ColumnIndex
$c* :: ColumnIndex -> ColumnIndex -> ColumnIndex
* :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cnegate :: ColumnIndex -> ColumnIndex
negate :: ColumnIndex -> ColumnIndex
$cabs :: ColumnIndex -> ColumnIndex
abs :: ColumnIndex -> ColumnIndex
$csignum :: ColumnIndex -> ColumnIndex
signum :: ColumnIndex -> ColumnIndex
$cfromInteger :: Integer -> ColumnIndex
fromInteger :: Integer -> ColumnIndex
Num, Num ColumnIndex
Ord ColumnIndex
(Num ColumnIndex, Ord ColumnIndex) =>
(ColumnIndex -> Rational) -> Real ColumnIndex
ColumnIndex -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ColumnIndex -> Rational
toRational :: ColumnIndex -> Rational
Real, Enum ColumnIndex
Real ColumnIndex
(Real ColumnIndex, Enum ColumnIndex) =>
(ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex))
-> (ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex))
-> (ColumnIndex -> Integer)
-> Integral ColumnIndex
ColumnIndex -> Integer
ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
ColumnIndex -> ColumnIndex -> ColumnIndex
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ColumnIndex -> ColumnIndex -> ColumnIndex
quot :: ColumnIndex -> ColumnIndex -> ColumnIndex
$crem :: ColumnIndex -> ColumnIndex -> ColumnIndex
rem :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cdiv :: ColumnIndex -> ColumnIndex -> ColumnIndex
div :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cmod :: ColumnIndex -> ColumnIndex -> ColumnIndex
mod :: ColumnIndex -> ColumnIndex -> ColumnIndex
$cquotRem :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
quotRem :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
$cdivMod :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
divMod :: ColumnIndex -> ColumnIndex -> (ColumnIndex, ColumnIndex)
$ctoInteger :: ColumnIndex -> Integer
toInteger :: ColumnIndex -> Integer
Integral)
data NamedParam where
(:=) :: (ToField v) => T.Text -> v -> NamedParam
data TransactionType
= Deferred
| Immediate
| Exclusive
| Savepoint T.Text
infixr 3 :=
instance Show NamedParam where
show :: NamedParam -> [Char]
show (Text
k := v
v) = (Text, SQLData) -> [Char]
forall a. Show a => a -> [Char]
show (Text
k, v -> SQLData
forall a. ToField a => a -> SQLData
toField v
v)
data FormatError = FormatError {
FormatError -> [Char]
fmtMessage :: String
, FormatError -> Query
fmtQuery :: Query
, FormatError -> [[Char]]
fmtParams :: [String]
} deriving (FormatError -> FormatError -> Bool
(FormatError -> FormatError -> Bool)
-> (FormatError -> FormatError -> Bool) -> Eq FormatError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatError -> FormatError -> Bool
== :: FormatError -> FormatError -> Bool
$c/= :: FormatError -> FormatError -> Bool
/= :: FormatError -> FormatError -> Bool
Eq, Int -> FormatError -> ShowS
[FormatError] -> ShowS
FormatError -> [Char]
(Int -> FormatError -> ShowS)
-> (FormatError -> [Char])
-> ([FormatError] -> ShowS)
-> Show FormatError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatError -> ShowS
showsPrec :: Int -> FormatError -> ShowS
$cshow :: FormatError -> [Char]
show :: FormatError -> [Char]
$cshowList :: [FormatError] -> ShowS
showList :: [FormatError] -> ShowS
Show, Typeable)
instance Exception FormatError
open :: String -> IO Connection
open :: [Char] -> IO Connection
open [Char]
fname = Database -> IORef Word64 -> Connection
Connection (Database -> IORef Word64 -> Connection)
-> IO Database -> IO (IORef Word64 -> Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Database
Base.open ([Char] -> Text
T.pack [Char]
fname) IO (IORef Word64 -> Connection)
-> IO (IORef Word64) -> IO Connection
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word64 -> IO (IORef Word64)
forall a. a -> IO (IORef a)
newIORef Word64
0
close :: Connection -> IO ()
close :: Connection -> IO ()
close = Database -> IO ()
Base.close (Database -> IO ())
-> (Connection -> Database) -> Connection -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Database
connectionHandle
withConnection :: String -> (Connection -> IO a) -> IO a
withConnection :: forall a. [Char] -> (Connection -> IO a) -> IO a
withConnection [Char]
connString = IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Char] -> IO Connection
open [Char]
connString) Connection -> IO ()
close
unUtf8 :: BaseD.Utf8 -> T.Text
unUtf8 :: Utf8 -> Text
unUtf8 (BaseD.Utf8 ByteString
bs) = ByteString -> Text
TE.decodeUtf8 ByteString
bs
setTrace :: Connection -> Maybe (T.Text -> IO ()) -> IO ()
setTrace :: Connection -> Maybe (Text -> IO ()) -> IO ()
setTrace Connection
conn Maybe (Text -> IO ())
logger =
Database -> Maybe (Utf8 -> IO ()) -> IO ()
BaseD.setTrace (Connection -> Database
connectionHandle Connection
conn) (((Text -> IO ()) -> Utf8 -> IO ())
-> Maybe (Text -> IO ()) -> Maybe (Utf8 -> IO ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text -> IO ()
lf -> Text -> IO ()
lf (Text -> IO ()) -> (Utf8 -> Text) -> Utf8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8 -> Text
unUtf8) Maybe (Text -> IO ())
logger)
bind :: (ToRow params) => Statement -> params -> IO ()
bind :: forall params. ToRow params => Statement -> params -> IO ()
bind (Statement Statement
stmt) params
params = do
let qp :: [SQLData]
qp = params -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow params
params
ParamIndex
stmtParamCount <- Statement -> IO ParamIndex
Base.bindParameterCount Statement
stmt
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([SQLData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
qp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ParamIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ParamIndex
stmtParamCount) ([SQLData] -> ParamIndex -> IO ()
throwColumnMismatch [SQLData]
qp ParamIndex
stmtParamCount)
(ParamIndex -> IO ()) -> [ParamIndex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([SQLData] -> ParamIndex -> IO ()
errorCheckParamName [SQLData]
qp) [ParamIndex
1..ParamIndex
stmtParamCount]
Statement -> [SQLData] -> IO ()
Base.bind Statement
stmt [SQLData]
qp
where
throwColumnMismatch :: [SQLData] -> ParamIndex -> IO ()
throwColumnMismatch [SQLData]
qp ParamIndex
nParams = do
Query
templ <- Statement -> IO Query
getQuery Statement
stmt
[Char] -> Query -> [SQLData] -> IO ()
forall v a. Show v => [Char] -> Query -> [v] -> a
fmtError ([Char]
"SQL query contains " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamIndex -> [Char]
forall a. Show a => a -> [Char]
show ParamIndex
nParams [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" params, but " [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]
qp) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" arguments given") Query
templ [SQLData]
qp
errorCheckParamName :: [SQLData] -> ParamIndex -> IO ()
errorCheckParamName [SQLData]
qp ParamIndex
paramNdx = do
Query
templ <- Statement -> IO Query
getQuery Statement
stmt
Maybe Text
name <- Statement -> ParamIndex -> IO (Maybe Text)
Base.bindParameterName Statement
stmt ParamIndex
paramNdx
case Maybe Text
name of
Just Text
n ->
[Char] -> Query -> [SQLData] -> IO ()
forall v a. Show v => [Char] -> Query -> [v] -> a
fmtError ([Char]
"Only unnamed '?' query parameters are accepted, '"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
n[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"' given")
Query
templ [SQLData]
qp
Maybe Text
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
bindNamed :: Statement -> [NamedParam] -> IO ()
bindNamed :: Statement -> [NamedParam] -> IO ()
bindNamed (Statement Statement
stmt) [NamedParam]
params = do
ParamIndex
stmtParamCount <- Statement -> IO ParamIndex
Base.bindParameterCount Statement
stmt
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([NamedParam] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NamedParam]
params Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ParamIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ParamIndex
stmtParamCount) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ParamIndex -> IO ()
throwColumnMismatch ParamIndex
stmtParamCount
Statement -> [NamedParam] -> IO ()
bind Statement
stmt [NamedParam]
params
where
bind :: Statement -> [NamedParam] -> IO ()
bind Statement
stmt [NamedParam]
params =
(NamedParam -> IO ()) -> [NamedParam] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Text
n := v
v) -> do
Maybe ParamIndex
idx <- Statement -> Utf8 -> IO (Maybe ParamIndex)
BaseD.bindParameterIndex Statement
stmt (ByteString -> Utf8
BaseD.Utf8 (ByteString -> Utf8) -> (Text -> ByteString) -> Text -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> Utf8) -> Text -> Utf8
forall a b. (a -> b) -> a -> b
$ Text
n)
case Maybe ParamIndex
idx of
Just ParamIndex
i ->
Statement -> ParamIndex -> SQLData -> IO ()
Base.bindSQLData Statement
stmt ParamIndex
i (v -> SQLData
forall a. ToField a => a -> SQLData
toField v
v)
Maybe ParamIndex
Nothing -> do
Query
templ <- Statement -> IO Query
getQuery Statement
stmt
[Char] -> Query -> [NamedParam] -> IO ()
forall v a. Show v => [Char] -> Query -> [v] -> a
fmtError ([Char]
"Unknown named parameter '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"'")
Query
templ [NamedParam]
params)
[NamedParam]
params
throwColumnMismatch :: ParamIndex -> IO ()
throwColumnMismatch ParamIndex
nParams = do
Query
templ <- Statement -> IO Query
getQuery Statement
stmt
[Char] -> Query -> [NamedParam] -> IO ()
forall v a. Show v => [Char] -> Query -> [v] -> a
fmtError ([Char]
"SQL query contains " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamIndex -> [Char]
forall a. Show a => a -> [Char]
show ParamIndex
nParams [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" params, but " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
Int -> [Char]
forall a. Show a => a -> [Char]
show ([NamedParam] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NamedParam]
params) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" arguments given") Query
templ [NamedParam]
params
reset :: Statement -> IO ()
reset :: Statement -> IO ()
reset (Statement Statement
stmt) = Statement -> IO ()
Base.reset Statement
stmt
columnName :: Statement -> ColumnIndex -> IO T.Text
columnName :: Statement -> ColumnIndex -> IO Text
columnName (Statement Statement
stmt) (ColumnIndex ColumnIndex
n) = Statement -> ColumnIndex -> IO (Maybe Utf8)
BaseD.columnName Statement
stmt ColumnIndex
n IO (Maybe Utf8) -> (Maybe 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
>>= Maybe Utf8 -> IO Text
takeUtf8
where
takeUtf8 :: Maybe Utf8 -> IO Text
takeUtf8 (Just Utf8
s) = Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Utf8 -> Text
unUtf8 Utf8
s
takeUtf8 Maybe Utf8
Nothing =
ArrayException -> IO Text
forall e a. Exception e => e -> IO a
throwIO ([Char] -> ArrayException
IndexOutOfBounds ([Char]
"Column index " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ColumnIndex -> [Char]
forall a. Show a => a -> [Char]
show ColumnIndex
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" out of bounds"))
columnCount :: Statement -> IO ColumnIndex
columnCount :: Statement -> IO ColumnIndex
columnCount (Statement Statement
stmt) = ColumnIndex -> ColumnIndex
ColumnIndex (ColumnIndex -> ColumnIndex) -> IO ColumnIndex -> IO ColumnIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> IO ColumnIndex
BaseD.columnCount Statement
stmt
withBind :: (ToRow params) => Statement -> params -> IO a -> IO a
withBind :: forall params a.
ToRow params =>
Statement -> params -> IO a -> IO a
withBind Statement
stmt params
params IO a
io = do
Statement -> params -> IO ()
forall params. ToRow params => Statement -> params -> IO ()
bind Statement
stmt params
params
IO a
io IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` Statement -> IO ()
reset Statement
stmt
openStatement :: Connection -> Query -> IO Statement
openStatement :: Connection -> Query -> IO Statement
openStatement Connection
conn (Query Text
t) = do
Statement
stmt <- Database -> Text -> IO Statement
Base.prepare (Connection -> Database
connectionHandle Connection
conn) Text
t
Statement -> IO Statement
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> IO Statement) -> Statement -> IO Statement
forall a b. (a -> b) -> a -> b
$ Statement -> Statement
Statement Statement
stmt
closeStatement :: Statement -> IO ()
closeStatement :: Statement -> IO ()
closeStatement (Statement Statement
stmt) = Statement -> IO ()
Base.finalize Statement
stmt
withStatement :: Connection -> Query -> (Statement -> IO a) -> IO a
withStatement :: forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
query = IO Statement -> (Statement -> IO ()) -> (Statement -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Connection -> Query -> IO Statement
openStatement Connection
conn Query
query) Statement -> IO ()
closeStatement
withStatementParams :: (ToRow params)
=> Connection
-> Query
-> params
-> (Statement -> IO a)
-> IO a
withStatementParams :: forall params a.
ToRow params =>
Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams Connection
conn Query
template params
params Statement -> IO a
action =
Connection -> Query -> (Statement -> IO a) -> IO a
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Statement
stmt ->
Statement -> [SQLData] -> IO ()
forall params. ToRow params => Statement -> params -> IO ()
bind Statement
stmt (params -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow params
params) IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Statement -> IO a
action Statement
stmt
withStatementNamedParams :: Connection
-> Query
-> [NamedParam]
-> (Statement -> IO a)
-> IO a
withStatementNamedParams :: forall a.
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams Connection
conn Query
template [NamedParam]
namedParams Statement -> IO a
action =
Connection -> Query -> (Statement -> IO a) -> IO a
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Statement
stmt -> Statement -> [NamedParam] -> IO ()
bindNamed Statement
stmt [NamedParam]
namedParams IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Statement -> IO a
action Statement
stmt
execute :: (ToRow q) => Connection -> Query -> q -> IO ()
execute :: forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
template q
qs =
Connection -> Query -> q -> (Statement -> IO ()) -> IO ()
forall params a.
ToRow params =>
Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams Connection
conn Query
template q
qs ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Statement Statement
stmt) ->
IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ())
-> (Statement -> IO StepResult) -> Statement -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement -> IO StepResult
Base.step (Statement -> IO ()) -> Statement -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement
stmt
executeMany :: ToRow q => Connection -> Query -> [q] -> IO ()
executeMany :: forall q. ToRow q => Connection -> Query -> [q] -> IO ()
executeMany Connection
conn Query
template [q]
paramRows = Connection -> Query -> (Statement -> IO ()) -> IO ()
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Statement
stmt -> do
let Statement Statement
stmt' = Statement
stmt
[q] -> (q -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [q]
paramRows ((q -> IO ()) -> IO ()) -> (q -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \q
params ->
Statement -> q -> IO () -> IO ()
forall params a.
ToRow params =>
Statement -> params -> IO a -> IO a
withBind Statement
stmt q
params
(IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ())
-> (Statement -> IO StepResult) -> Statement -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement -> IO StepResult
Base.step (Statement -> IO ()) -> Statement -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement
stmt')
doFoldToList :: RowParser row -> Statement -> IO [row]
doFoldToList :: forall row. RowParser row -> Statement -> IO [row]
doFoldToList RowParser row
fromRow_ Statement
stmt =
([row] -> [row]) -> IO [row] -> IO [row]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [row] -> [row]
forall a. [a] -> [a]
reverse (IO [row] -> IO [row]) -> IO [row] -> IO [row]
forall a b. (a -> b) -> a -> b
$ RowParser row
-> Statement -> [row] -> ([row] -> row -> IO [row]) -> IO [row]
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
fromRow_ Statement
stmt [] (\[row]
acc row
e -> [row] -> IO [row]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (row
e row -> [row] -> [row]
forall a. a -> [a] -> [a]
: [row]
acc))
query :: (ToRow q, FromRow r)
=> Connection -> Query -> q -> IO [r]
query :: forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query = RowParser r -> Connection -> Query -> q -> IO [r]
forall q r.
ToRow q =>
RowParser r -> Connection -> Query -> q -> IO [r]
queryWith RowParser r
forall a. FromRow a => RowParser a
fromRow
query_ :: (FromRow r) => Connection -> Query -> IO [r]
query_ :: forall r. FromRow r => Connection -> Query -> IO [r]
query_ = RowParser r -> Connection -> Query -> IO [r]
forall r. RowParser r -> Connection -> Query -> IO [r]
queryWith_ RowParser r
forall a. FromRow a => RowParser a
fromRow
queryWith :: (ToRow q) => RowParser r -> Connection -> Query -> q -> IO [r]
queryWith :: forall q r.
ToRow q =>
RowParser r -> Connection -> Query -> q -> IO [r]
queryWith RowParser r
fromRow_ Connection
conn Query
templ q
qs =
Connection -> Query -> q -> (Statement -> IO [r]) -> IO [r]
forall params a.
ToRow params =>
Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams Connection
conn Query
templ q
qs ((Statement -> IO [r]) -> IO [r])
-> (Statement -> IO [r]) -> IO [r]
forall a b. (a -> b) -> a -> b
$ \Statement
stmt -> RowParser r -> Statement -> IO [r]
forall row. RowParser row -> Statement -> IO [row]
doFoldToList RowParser r
fromRow_ Statement
stmt
queryWith_ :: RowParser r -> Connection -> Query -> IO [r]
queryWith_ :: forall r. RowParser r -> Connection -> Query -> IO [r]
queryWith_ RowParser r
fromRow_ Connection
conn Query
query =
Connection -> Query -> (Statement -> IO [r]) -> IO [r]
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
query (RowParser r -> Statement -> IO [r]
forall row. RowParser row -> Statement -> IO [row]
doFoldToList RowParser r
fromRow_)
queryNamed :: (FromRow r) => Connection -> Query -> [NamedParam] -> IO [r]
queryNamed :: forall r.
FromRow r =>
Connection -> Query -> [NamedParam] -> IO [r]
queryNamed Connection
conn Query
templ [NamedParam]
params =
Connection
-> Query -> [NamedParam] -> (Statement -> IO [r]) -> IO [r]
forall a.
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams Connection
conn Query
templ [NamedParam]
params ((Statement -> IO [r]) -> IO [r])
-> (Statement -> IO [r]) -> IO [r]
forall a b. (a -> b) -> a -> b
$ \Statement
stmt -> RowParser r -> Statement -> IO [r]
forall row. RowParser row -> Statement -> IO [row]
doFoldToList RowParser r
forall a. FromRow a => RowParser a
fromRow Statement
stmt
execute_ :: Connection -> Query -> IO ()
execute_ :: Connection -> Query -> IO ()
execute_ Connection
conn Query
template =
Connection -> Query -> (Statement -> IO ()) -> IO ()
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
template ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Statement Statement
stmt) ->
IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ()) -> IO StepResult -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement -> IO StepResult
Base.step Statement
stmt
executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
executeNamed Connection
conn Query
template [NamedParam]
params =
Connection
-> Query -> [NamedParam] -> (Statement -> IO ()) -> IO ()
forall a.
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams Connection
conn Query
template [NamedParam]
params ((Statement -> IO ()) -> IO ()) -> (Statement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Statement Statement
stmt) ->
IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StepResult -> IO ()) -> IO StepResult -> IO ()
forall a b. (a -> b) -> a -> b
$ Statement -> IO StepResult
Base.step Statement
stmt
fold :: ( FromRow row, ToRow params )
=> Connection
-> Query
-> params
-> a
-> (a -> row -> IO a)
-> IO a
fold :: forall row params a.
(FromRow row, ToRow params) =>
Connection -> Query -> params -> a -> (a -> row -> IO a) -> IO a
fold Connection
conn Query
query params
params a
initalState a -> row -> IO a
action =
Connection -> Query -> params -> (Statement -> IO a) -> IO a
forall params a.
ToRow params =>
Connection -> Query -> params -> (Statement -> IO a) -> IO a
withStatementParams Connection
conn Query
query params
params ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Statement
stmt ->
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
forall a. FromRow a => RowParser a
fromRow Statement
stmt a
initalState a -> row -> IO a
action
fold_ :: ( FromRow row )
=> Connection
-> Query
-> a
-> (a -> row -> IO a)
-> IO a
fold_ :: forall row a.
FromRow row =>
Connection -> Query -> a -> (a -> row -> IO a) -> IO a
fold_ Connection
conn Query
query a
initalState a -> row -> IO a
action =
Connection -> Query -> (Statement -> IO a) -> IO a
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn Query
query ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Statement
stmt ->
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
forall a. FromRow a => RowParser a
fromRow Statement
stmt a
initalState a -> row -> IO a
action
foldNamed :: ( FromRow row )
=> Connection
-> Query
-> [NamedParam]
-> a
-> (a -> row -> IO a)
-> IO a
foldNamed :: forall row a.
FromRow row =>
Connection
-> Query -> [NamedParam] -> a -> (a -> row -> IO a) -> IO a
foldNamed Connection
conn Query
query [NamedParam]
params a
initalState a -> row -> IO a
action =
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
forall a.
Connection -> Query -> [NamedParam] -> (Statement -> IO a) -> IO a
withStatementNamedParams Connection
conn Query
query [NamedParam]
params ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Statement
stmt ->
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
forall a. FromRow a => RowParser a
fromRow Statement
stmt a
initalState a -> row -> IO a
action
doFold :: RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold :: forall row a.
RowParser row -> Statement -> a -> (a -> row -> IO a) -> IO a
doFold RowParser row
fromRow_ Statement
stmt a
initState a -> row -> IO a
action =
a -> IO a
loop a
initState
where
loop :: a -> IO a
loop a
val = do
Maybe row
maybeNextRow <- RowParser row -> Statement -> IO (Maybe row)
forall r. RowParser r -> Statement -> IO (Maybe r)
nextRowWith RowParser row
fromRow_ Statement
stmt
case Maybe row
maybeNextRow of
Just row
row -> do
a
val' <- a -> row -> IO a
action a
val row
row
a
val' a -> IO a -> IO a
forall a b. a -> b -> b
`seq` a -> IO a
loop a
val'
Maybe row
Nothing -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
nextRow :: (FromRow r) => Statement -> IO (Maybe r)
nextRow :: forall r. FromRow r => Statement -> IO (Maybe r)
nextRow = RowParser r -> Statement -> IO (Maybe r)
forall r. RowParser r -> Statement -> IO (Maybe r)
nextRowWith RowParser r
forall a. FromRow a => RowParser a
fromRow
nextRowWith :: RowParser r -> Statement -> IO (Maybe r)
nextRowWith :: forall r. RowParser r -> Statement -> IO (Maybe r)
nextRowWith RowParser r
fromRow_ (Statement Statement
stmt) = do
StepResult
statRes <- Statement -> IO StepResult
Base.step Statement
stmt
case StepResult
statRes of
StepResult
Base.Row -> do
[SQLData]
rowRes <- Statement -> IO [SQLData]
Base.columns Statement
stmt
let nCols :: Int
nCols = [SQLData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SQLData]
rowRes
r
row <- RowParser r -> [SQLData] -> Int -> IO r
forall r. RowParser r -> [SQLData] -> Int -> IO r
convertRow RowParser r
fromRow_ [SQLData]
rowRes Int
nCols
Maybe r -> IO (Maybe r)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe r -> IO (Maybe r)) -> Maybe r -> IO (Maybe r)
forall a b. (a -> b) -> a -> b
$ r -> Maybe r
forall a. a -> Maybe a
Just r
row
StepResult
Base.Done -> Maybe r -> IO (Maybe r)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe r
forall a. Maybe a
Nothing
convertRow :: RowParser r -> [Base.SQLData] -> Int -> IO r
convertRow :: forall r. RowParser r -> [SQLData] -> Int -> IO r
convertRow RowParser r
fromRow_ [SQLData]
rowRes Int
ncols = do
let rw :: RowParseRO
rw = Int -> RowParseRO
RowParseRO Int
ncols
case StateT (Int, [SQLData]) Ok r
-> (Int, [SQLData]) -> Ok (r, (Int, [SQLData]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) r
-> RowParseRO -> StateT (Int, [SQLData]) Ok r
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RowParser r -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) r
forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP RowParser r
fromRow_) RowParseRO
rw) (Int
0, [SQLData]
rowRes) of
Ok (r
val,(Int
col,[SQLData]
_))
| Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ncols -> r -> IO r
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return r
val
| Bool
otherwise -> ColumnOutOfBounds -> IO r
forall r. ColumnOutOfBounds -> IO r
errorColumnMismatch (Int -> ColumnOutOfBounds
ColumnOutOfBounds Int
col)
Errors [] -> ResultError -> IO r
forall e a. Exception e => e -> IO a
throwIO (ResultError -> IO r) -> ResultError -> IO r
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char] -> ResultError
ConversionFailed [Char]
"" [Char]
"" [Char]
"unknown error"
Errors [SomeException
x] ->
SomeException -> IO r
forall a e. Exception e => e -> a
throw SomeException
x IO r -> (ColumnOutOfBounds -> IO r) -> IO r
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Control.Exception.catch` (\ColumnOutOfBounds
e -> ColumnOutOfBounds -> IO r
forall r. ColumnOutOfBounds -> IO r
errorColumnMismatch (ColumnOutOfBounds
e :: ColumnOutOfBounds))
Errors [SomeException]
xs -> ManyErrors -> IO r
forall e a. Exception e => e -> IO a
throwIO (ManyErrors -> IO r) -> ManyErrors -> IO r
forall a b. (a -> b) -> a -> b
$ [SomeException] -> ManyErrors
ManyErrors [SomeException]
xs
where
errorColumnMismatch :: ColumnOutOfBounds -> IO r
errorColumnMismatch :: forall r. ColumnOutOfBounds -> IO r
errorColumnMismatch (ColumnOutOfBounds Int
c) = do
let vals :: [(ByteString, Text)]
vals = (SQLData -> (ByteString, Text))
-> [SQLData] -> [(ByteString, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\SQLData
f -> (SQLData -> ByteString
gettypename SQLData
f, SQLData -> Text
ellipsis SQLData
f)) [SQLData]
rowRes
ResultError -> IO r
forall e a. Exception e => e -> IO a
throwIO ([Char] -> [Char] -> [Char] -> ResultError
ConversionFailed
(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ncols [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" values: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [(ByteString, Text)] -> [Char]
forall a. Show a => a -> [Char]
show [(ByteString, Text)]
vals)
([Char]
"at least " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" slots in target type")
[Char]
"mismatch between number of columns to convert and number in target type")
ellipsis :: Base.SQLData -> T.Text
ellipsis :: SQLData -> Text
ellipsis SQLData
sql
| Text -> Int
T.length Text
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20 = Int -> Text -> Text
T.take Int
15 Text
bs Text -> Text -> Text
`T.append` Text
"[...]"
| Bool
otherwise = Text
bs
where
bs :: Text
bs = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ SQLData -> [Char]
forall a. Show a => a -> [Char]
show SQLData
sql
withTransactionPrivate :: Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate :: forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action TransactionType
ttype =
((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
IO ()
begin
a
r <- IO a -> IO a
forall a. IO a -> IO a
restore IO a
action IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO ()
rollback
IO ()
commit
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
where
begin :: IO ()
begin = Connection -> Query -> IO ()
execute_ Connection
conn (Query -> IO ()) -> Query -> IO ()
forall a b. (a -> b) -> a -> b
$ case TransactionType
ttype of
TransactionType
Deferred -> Query
"BEGIN TRANSACTION"
TransactionType
Immediate -> Query
"BEGIN IMMEDIATE TRANSACTION"
TransactionType
Exclusive -> Query
"BEGIN EXCLUSIVE TRANSACTION"
Savepoint Text
name -> Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"SAVEPOINT '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
commit :: IO ()
commit = Connection -> Query -> IO ()
execute_ Connection
conn (Query -> IO ()) -> Query -> IO ()
forall a b. (a -> b) -> a -> b
$ case TransactionType
ttype of
Savepoint Text
name -> Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"RELEASE '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
TransactionType
_ -> Query
"COMMIT TRANSACTION"
rollback :: IO ()
rollback = Connection -> Query -> IO ()
execute_ Connection
conn (Query -> IO ()) -> Query -> IO ()
forall a b. (a -> b) -> a -> b
$ case TransactionType
ttype of
Savepoint Text
name -> Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"ROLLBACK TO '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
TransactionType
_ -> Query
"ROLLBACK TRANSACTION"
withImmediateTransaction :: Connection -> IO a -> IO a
withImmediateTransaction :: forall a. Connection -> IO a -> IO a
withImmediateTransaction Connection
conn IO a
action =
Connection -> IO a -> TransactionType -> IO a
forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action TransactionType
Immediate
withExclusiveTransaction :: Connection -> IO a -> IO a
withExclusiveTransaction :: forall a. Connection -> IO a -> IO a
withExclusiveTransaction Connection
conn IO a
action =
Connection -> IO a -> TransactionType -> IO a
forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action TransactionType
Exclusive
lastInsertRowId :: Connection -> IO Int64
lastInsertRowId :: Connection -> IO Int64
lastInsertRowId = Database -> IO Int64
BaseD.lastInsertRowId (Database -> IO Int64)
-> (Connection -> Database) -> Connection -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Database
connectionHandle
changes :: Connection -> IO Int
changes :: Connection -> IO Int
changes = Database -> IO Int
BaseD.changes (Database -> IO Int)
-> (Connection -> Database) -> Connection -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Database
connectionHandle
totalChanges :: Connection -> IO Int
totalChanges :: Connection -> IO Int
totalChanges = Database -> IO Int
BaseD.totalChanges (Database -> IO Int)
-> (Connection -> Database) -> Connection -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Database
connectionHandle
withTransaction :: Connection -> IO a -> IO a
withTransaction :: forall a. Connection -> IO a -> IO a
withTransaction Connection
conn IO a
action =
Connection -> IO a -> TransactionType -> IO a
forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action TransactionType
Deferred
withSavepoint :: Connection -> IO a -> IO a
withSavepoint :: forall a. Connection -> IO a -> IO a
withSavepoint Connection
conn IO a
action = do
Word64
n <- IORef Word64 -> (Word64 -> (Word64, Word64)) -> IO Word64
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (Connection -> IORef Word64
connectionTempNameCounter Connection
conn) ((Word64 -> (Word64, Word64)) -> IO Word64)
-> (Word64 -> (Word64, Word64)) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Word64
n -> (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1, Word64
n)
Connection -> IO a -> TransactionType -> IO a
forall a. Connection -> IO a -> TransactionType -> IO a
withTransactionPrivate Connection
conn IO a
action (TransactionType -> IO a) -> TransactionType -> IO a
forall a b. (a -> b) -> a -> b
$
Text -> TransactionType
Savepoint (Text -> TransactionType) -> Text -> TransactionType
forall a b. (a -> b) -> a -> b
$ Text
"sqlite_simple_savepoint_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
n)
fmtError :: Show v => String -> Query -> [v] -> a
fmtError :: forall v a. Show v => [Char] -> Query -> [v] -> a
fmtError [Char]
msg Query
q [v]
xs =
FormatError -> a
forall a e. Exception e => e -> a
throw FormatError {
fmtMessage :: [Char]
fmtMessage = [Char]
msg
, fmtQuery :: Query
fmtQuery = Query
q
, fmtParams :: [[Char]]
fmtParams = (v -> [Char]) -> [v] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map v -> [Char]
forall a. Show a => a -> [Char]
show [v]
xs
}
getQuery :: Base.Statement -> IO Query
getQuery :: Statement -> IO Query
getQuery Statement
stmt =
Maybe Utf8 -> Query
toQuery (Maybe Utf8 -> Query) -> IO (Maybe Utf8) -> IO Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> IO (Maybe Utf8)
BaseD.statementSql Statement
stmt
where
toQuery :: Maybe Utf8 -> Query
toQuery =
Text -> Query
Query (Text -> Query) -> (Maybe Utf8 -> Text) -> Maybe Utf8 -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Utf8 -> Text) -> Maybe Utf8 -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"no query string" (\(BaseD.Utf8 ByteString
s) -> ByteString -> Text
TE.decodeUtf8 ByteString
s)