{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings #-}
module Database.MySQL.Simple
(
Base.ConnectInfo(..)
, Connection
, Query
, In(..)
, VaArgs(..)
, Binary(..)
, Only(..)
, Param
, Result
, FormatError(fmtMessage, fmtQuery, fmtParams)
, QueryError(qeMessage, qeQuery)
, ResultError(errSQLType, errHaskellType, errMessage)
, Base.connect
, Base.defaultConnectInfo
, Base.close
, query
, query_
, fold
, fold_
, forEach
, forEach_
, execute
, execute_
, executeMany
, Base.insertID
, withTransaction
, Base.autocommit
, Base.commit
, Base.rollback
, formatMany
, formatQuery
, splitQuery
, FromField(..)
, ToField(..)
) where
import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)
import Blaze.ByteString.Builder.Char8 (fromChar)
import Control.Applicative ((<$>), pure)
import Control.Exception (Exception, bracket, onException, throw, throwIO)
import Control.Monad.Fix (fix)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Int (Int64)
import Data.List (intersperse)
import Data.Monoid (mappend, mconcat)
import Data.Typeable (Typeable)
import Database.MySQL.Base (Connection)
import qualified Database.MySQL.Base as Base (Result)
import Database.MySQL.Base.Types (Field)
import Database.MySQL.Simple.Param (ToField(..), Param, Action(..), inQuotes)
import Database.MySQL.Simple.QueryParams (QueryParams(..))
import Database.MySQL.Simple.QueryResults (QueryResults(..))
import Database.MySQL.Simple.Result (FromField(..), Result, ResultError(..))
import Database.MySQL.Simple.Types (Binary(..), In(..), VaArgs(..), Only(..), Query(..))
import Text.Regex.PCRE.Light (compile, caseless, match)
import qualified Data.ByteString.Char8 as B
import qualified Database.MySQL.Base as Base
data FormatError = FormatError {
FormatError -> [Char]
fmtMessage :: String
, FormatError -> Query
fmtQuery :: Query
, FormatError -> [ByteString]
fmtParams :: [ByteString]
} deriving (FormatError -> FormatError -> Bool
(FormatError -> FormatError -> Bool)
-> (FormatError -> FormatError -> Bool) -> Eq FormatError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatError -> FormatError -> Bool
$c/= :: FormatError -> FormatError -> Bool
== :: FormatError -> FormatError -> Bool
$c== :: 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
showList :: [FormatError] -> ShowS
$cshowList :: [FormatError] -> ShowS
show :: FormatError -> [Char]
$cshow :: FormatError -> [Char]
showsPrec :: Int -> FormatError -> ShowS
$cshowsPrec :: Int -> FormatError -> ShowS
Show, Typeable)
instance Exception FormatError
data QueryError = QueryError {
QueryError -> [Char]
qeMessage :: String
, QueryError -> Query
qeQuery :: Query
} deriving (QueryError -> QueryError -> Bool
(QueryError -> QueryError -> Bool)
-> (QueryError -> QueryError -> Bool) -> Eq QueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryError -> QueryError -> Bool
$c/= :: QueryError -> QueryError -> Bool
== :: QueryError -> QueryError -> Bool
$c== :: QueryError -> QueryError -> Bool
Eq, Int -> QueryError -> ShowS
[QueryError] -> ShowS
QueryError -> [Char]
(Int -> QueryError -> ShowS)
-> (QueryError -> [Char])
-> ([QueryError] -> ShowS)
-> Show QueryError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [QueryError] -> ShowS
$cshowList :: [QueryError] -> ShowS
show :: QueryError -> [Char]
$cshow :: QueryError -> [Char]
showsPrec :: Int -> QueryError -> ShowS
$cshowsPrec :: Int -> QueryError -> ShowS
Show, Typeable)
instance Exception QueryError
formatQuery :: QueryParams q => Connection -> Query -> q -> IO ByteString
formatQuery :: forall q.
QueryParams q =>
Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn q :: Query
q@(Query ByteString
template) q
qs
| [Action] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Action]
xs Bool -> Bool -> Bool
&& Char
'?' Char -> ByteString -> Bool
`B.notElem` ByteString
template = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
template
| Bool
otherwise = Builder -> ByteString
toByteString (Builder -> ByteString) -> IO Builder -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> ByteString -> [Action] -> IO Builder
buildQuery Connection
conn Query
q ByteString
template [Action]
xs
where xs :: [Action]
xs = q -> [Action]
forall a. QueryParams a => a -> [Action]
renderParams q
qs
formatMany :: (QueryParams q) => Connection -> Query -> [q] -> IO ByteString
formatMany :: forall q.
QueryParams q =>
Connection -> Query -> [q] -> IO ByteString
formatMany Connection
_ Query
q [] = [Char] -> Query -> [Action] -> IO ByteString
forall a. [Char] -> Query -> [Action] -> a
fmtError [Char]
"no rows supplied" Query
q []
formatMany Connection
conn q :: Query
q@(Query ByteString
template) [q]
qs = do
case Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
re ByteString
template [] of
Just [ByteString
_,ByteString
before,ByteString
qbits,ByteString
after] -> do
[Builder]
bs <- (q -> IO Builder) -> [q] -> IO [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Connection -> Query -> ByteString -> [Action] -> IO Builder
buildQuery Connection
conn Query
q ByteString
qbits ([Action] -> IO Builder) -> (q -> [Action]) -> q -> IO Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q -> [Action]
forall a. QueryParams a => a -> [Action]
renderParams) [q]
qs
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> ([Builder] -> ByteString) -> [Builder] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toByteString (Builder -> ByteString)
-> ([Builder] -> Builder) -> [Builder] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> IO ByteString) -> [Builder] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
before Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
:
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
fromChar Char
',') [Builder]
bs [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++
[ByteString -> Builder
fromByteString ByteString
after]
Maybe [ByteString]
_ -> [Char] -> Query -> [Action] -> IO ByteString
forall a. [Char] -> Query -> [Action] -> a
fmtError [Char]
"incorrect parameter syntax in query" Query
q []
where
re :: Regex
re = ByteString -> [PCREOption] -> Regex
compile ByteString
"^([^?]+\\bvalues\\s*)\
\(\\(\\s*[?](?:\\s*,\\s*[?])*\\s*\\))\
\([^?]*)$"
[PCREOption
caseless]
buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
buildQuery Connection
conn Query
q ByteString
template [Action]
xs = [Builder] -> [Builder] -> Builder
forall {a}. Monoid a => [a] -> [a] -> a
zipParams [Builder]
queryFragments ([Builder] -> Builder) -> IO [Builder] -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Action -> IO Builder) -> [Action] -> IO [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Action -> IO Builder
sub [Action]
xs
where sub :: Action -> IO Builder
sub (Plain Builder
b) = Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
b
sub (Escape ByteString
s) = (Builder -> Builder
inQuotes (Builder -> Builder)
-> (ByteString -> Builder) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromByteString) (ByteString -> Builder) -> IO ByteString -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO ByteString
Base.escape Connection
conn ByteString
s
sub (Many [Action]
ys) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> IO [Builder] -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Action -> IO Builder) -> [Action] -> IO [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Action -> IO Builder
sub [Action]
ys
zipParams :: [a] -> [a] -> a
zipParams (a
t:[a]
ts) (a
p:[a]
ps) = a
t a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
p a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` [a] -> [a] -> a
zipParams [a]
ts [a]
ps
zipParams [a
t] [] = a
t
zipParams [a]
_ [a]
_ = [Char] -> Query -> [Action] -> a
forall a. [Char] -> Query -> [Action] -> a
fmtError (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fragmentCount [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
" '?' characters, but " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
Int -> [Char]
forall a. Show a => a -> [Char]
show ([Action] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Action]
xs) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" parameters") Query
q [Action]
xs
fragmentCount :: Int
fragmentCount = [Builder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
queryFragments Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
queryFragments :: [Builder]
queryFragments = ByteString -> [Builder]
splitQuery ByteString
template
splitQuery :: ByteString -> [Builder]
splitQuery :: ByteString -> [Builder]
splitQuery ByteString
s =
[Builder] -> [Builder]
forall a. [a] -> [a]
reverse ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Builder) -> [[Char]] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Builder
fromByteString (ByteString -> Builder)
-> ([Char] -> ByteString) -> [Char] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BS.pack ([Char] -> ByteString) -> ShowS -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) ([[Char]] -> [Builder]) -> [[Char]] -> [Builder]
forall a b. (a -> b) -> a -> b
$
[Char] -> [Char] -> [[Char]]
begin [] (ByteString -> [Char]
BS.unpack ByteString
s)
where
begin :: [Char] -> [Char] -> [[Char]]
begin = [[Char]] -> [Char] -> [Char] -> [[Char]]
normal []
normal :: [[Char]] -> [Char] -> [Char] -> [[Char]]
normal [[Char]]
ret [Char]
acc [] =
[Char]
acc [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
ret
normal [[Char]]
ret [Char]
acc (Char
c : [Char]
cs) =
case Char
c of
Char
'?' ->
[[Char]] -> [Char] -> [Char] -> [[Char]]
normal ([Char]
acc [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
ret) [] [Char]
cs
Char
'\'' ->
[[Char]] -> [Char] -> [Char] -> [[Char]]
quotes [[Char]]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
cs
Char
_ ->
[[Char]] -> [Char] -> [Char] -> [[Char]]
normal [[Char]]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
cs
quotes :: [[Char]] -> [Char] -> [Char] -> [[Char]]
quotes [[Char]]
ret [Char]
acc [] =
[Char]
acc [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
ret
quotes [[Char]]
ret [Char]
acc (Char
c : [Char]
cs) =
case Char
c of
Char
'\'' ->
[[Char]] -> [Char] -> [Char] -> [[Char]]
normal [[Char]]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
cs
Char
_ ->
[[Char]] -> [Char] -> [Char] -> [[Char]]
quotes [[Char]]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
cs
execute :: (QueryParams q) => Connection -> Query -> q -> IO Int64
execute :: forall q. QueryParams q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
template q
qs = do
Connection -> ByteString -> IO ()
Base.query Connection
conn (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> Query -> q -> IO ByteString
forall q.
QueryParams q =>
Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
template q
qs
Connection -> Query -> IO Int64
finishExecute Connection
conn Query
template
execute_ :: Connection -> Query -> IO Int64
execute_ :: Connection -> Query -> IO Int64
execute_ Connection
conn q :: Query
q@(Query ByteString
stmt) = do
Connection -> ByteString -> IO ()
Base.query Connection
conn ByteString
stmt
Connection -> Query -> IO Int64
finishExecute Connection
conn Query
q
executeMany :: (QueryParams q) => Connection -> Query -> [q] -> IO Int64
executeMany :: forall q. QueryParams q => Connection -> Query -> [q] -> IO Int64
executeMany Connection
_ Query
_ [] = Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
executeMany Connection
conn Query
q [q]
qs = do
Connection -> ByteString -> IO ()
Base.query Connection
conn (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> Query -> [q] -> IO ByteString
forall q.
QueryParams q =>
Connection -> Query -> [q] -> IO ByteString
formatMany Connection
conn Query
q [q]
qs
Connection -> Query -> IO Int64
finishExecute Connection
conn Query
q
finishExecute :: Connection -> Query -> IO Int64
finishExecute :: Connection -> Query -> IO Int64
finishExecute Connection
conn Query
q = do
Int
ncols <- Either Connection Result -> IO Int
Base.fieldCount (Connection -> Either Connection Result
forall a b. a -> Either a b
Left Connection
conn)
if Int
ncols Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
then QueryError -> IO Int64
forall e a. Exception e => e -> IO a
throwIO (QueryError -> IO Int64) -> QueryError -> IO Int64
forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> QueryError
QueryError ([Char]
"execute resulted in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ncols [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
"-column result") Query
q
else Connection -> IO Int64
Base.affectedRows Connection
conn
query :: (QueryParams q, QueryResults r)
=> Connection -> Query -> q -> IO [r]
query :: forall q r.
(QueryParams q, QueryResults r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
template q
qs = do
Connection -> ByteString -> IO ()
Base.query Connection
conn (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> Query -> q -> IO ByteString
forall q.
QueryParams q =>
Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
template q
qs
Connection -> Query -> IO [r]
forall r. QueryResults r => Connection -> Query -> IO [r]
finishQuery Connection
conn Query
template
query_ :: (QueryResults r) => Connection -> Query -> IO [r]
query_ :: forall r. QueryResults r => Connection -> Query -> IO [r]
query_ Connection
conn q :: Query
q@(Query ByteString
que) = do
Connection -> ByteString -> IO ()
Base.query Connection
conn ByteString
que
Connection -> Query -> IO [r]
forall r. QueryResults r => Connection -> Query -> IO [r]
finishQuery Connection
conn Query
q
fold :: (QueryParams q, QueryResults r) =>
Connection
-> Query
-> q
-> a
-> (a -> r -> IO a)
-> IO a
fold :: forall q r a.
(QueryParams q, QueryResults r) =>
Connection -> Query -> q -> a -> (a -> r -> IO a) -> IO a
fold Connection
conn Query
template q
qs a
z a -> r -> IO a
f = do
Connection -> ByteString -> IO ()
Base.query Connection
conn (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> Query -> q -> IO ByteString
forall q.
QueryParams q =>
Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
template q
qs
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
forall r a.
QueryResults r =>
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
finishFold Connection
conn Query
template a
z a -> r -> IO a
f
fold_ :: (QueryResults r) =>
Connection
-> Query
-> a
-> (a -> r -> IO a)
-> IO a
fold_ :: forall r a.
QueryResults r =>
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
fold_ Connection
conn q :: Query
q@(Query ByteString
que) a
z a -> r -> IO a
f = do
Connection -> ByteString -> IO ()
Base.query Connection
conn ByteString
que
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
forall r a.
QueryResults r =>
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
finishFold Connection
conn Query
q a
z a -> r -> IO a
f
forEach :: (QueryParams q, QueryResults r) =>
Connection
-> Query
-> q
-> (r -> IO ())
-> IO ()
forEach :: forall q r.
(QueryParams q, QueryResults r) =>
Connection -> Query -> q -> (r -> IO ()) -> IO ()
forEach Connection
conn Query
template q
qs = Connection -> Query -> q -> () -> (() -> r -> IO ()) -> IO ()
forall q r a.
(QueryParams q, QueryResults r) =>
Connection -> Query -> q -> a -> (a -> r -> IO a) -> IO a
fold Connection
conn Query
template q
qs () ((() -> r -> IO ()) -> IO ())
-> ((r -> IO ()) -> () -> r -> IO ()) -> (r -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> IO ()) -> () -> r -> IO ()
forall a b. a -> b -> a
const
{-# INLINE forEach #-}
forEach_ :: (QueryResults r) =>
Connection
-> Query
-> (r -> IO ())
-> IO ()
forEach_ :: forall r.
QueryResults r =>
Connection -> Query -> (r -> IO ()) -> IO ()
forEach_ Connection
conn Query
template = Connection -> Query -> () -> (() -> r -> IO ()) -> IO ()
forall r a.
QueryResults r =>
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
fold_ Connection
conn Query
template () ((() -> r -> IO ()) -> IO ())
-> ((r -> IO ()) -> () -> r -> IO ()) -> (r -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> IO ()) -> () -> r -> IO ()
forall a b. a -> b -> a
const
{-# INLINE forEach_ #-}
finishQuery :: (QueryResults r) => Connection -> Query -> IO [r]
finishQuery :: forall r. QueryResults r => Connection -> Query -> IO [r]
finishQuery Connection
conn Query
q = IO Result -> Query -> (Result -> [Field] -> IO [r]) -> IO [r]
forall a. IO Result -> Query -> (Result -> [Field] -> IO a) -> IO a
withResult (Connection -> IO Result
Base.storeResult Connection
conn) Query
q ((Result -> [Field] -> IO [r]) -> IO [r])
-> (Result -> [Field] -> IO [r]) -> IO [r]
forall a b. (a -> b) -> a -> b
$ \Result
r [Field]
fs ->
((([r] -> IO [r]) -> [r] -> IO [r]) -> [r] -> IO [r])
-> [r] -> (([r] -> IO [r]) -> [r] -> IO [r]) -> IO [r]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([r] -> IO [r]) -> [r] -> IO [r]) -> [r] -> IO [r]
forall a. (a -> a) -> a
fix [] ((([r] -> IO [r]) -> [r] -> IO [r]) -> IO [r])
-> (([r] -> IO [r]) -> [r] -> IO [r]) -> IO [r]
forall a b. (a -> b) -> a -> b
$ \[r] -> IO [r]
loop [r]
acc -> do
[Maybe ByteString]
row <- Result -> IO [Maybe ByteString]
Base.fetchRow Result
r
case [Maybe ByteString]
row of
[] -> [r] -> IO [r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([r] -> [r]
forall a. [a] -> [a]
reverse [r]
acc)
[Maybe ByteString]
_ -> let !c :: r
c = [Field] -> [Maybe ByteString] -> r
forall a. QueryResults a => [Field] -> [Maybe ByteString] -> a
convertResults [Field]
fs [Maybe ByteString]
row
in [r] -> IO [r]
loop (r
cr -> [r] -> [r]
forall a. a -> [a] -> [a]
:[r]
acc)
finishFold :: (QueryResults r) =>
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
finishFold :: forall r a.
QueryResults r =>
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
finishFold Connection
conn Query
q a
z0 a -> r -> IO a
f = IO Result -> Query -> (Result -> [Field] -> IO a) -> IO a
forall a. IO Result -> Query -> (Result -> [Field] -> IO a) -> IO a
withResult (Connection -> IO Result
Base.useResult Connection
conn) Query
q ((Result -> [Field] -> IO a) -> IO a)
-> (Result -> [Field] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Result
r [Field]
fs ->
(((a -> IO a) -> a -> IO a) -> a -> IO a)
-> a -> ((a -> IO a) -> a -> IO a) -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> IO a) -> a -> IO a) -> a -> IO a
forall a. (a -> a) -> a
fix a
z0 (((a -> IO a) -> a -> IO a) -> IO a)
-> ((a -> IO a) -> a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \a -> IO a
loop a
z -> do
[Maybe ByteString]
row <- Result -> IO [Maybe ByteString]
Base.fetchRow Result
r
case [Maybe ByteString]
row of
[] -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z
[Maybe ByteString]
_ -> (a -> r -> IO a
f a
z (r -> IO a) -> r -> IO a
forall a b. (a -> b) -> a -> b
$! [Field] -> [Maybe ByteString] -> r
forall a. QueryResults a => [Field] -> [Maybe ByteString] -> a
convertResults [Field]
fs [Maybe ByteString]
row) IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
loop
withResult :: (IO Base.Result) -> Query -> (Base.Result -> [Field] -> IO a) -> IO a
withResult :: forall a. IO Result -> Query -> (Result -> [Field] -> IO a) -> IO a
withResult IO Result
fetchResult Query
q Result -> [Field] -> IO a
act = IO Result -> (Result -> IO ()) -> (Result -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Result
fetchResult Result -> IO ()
Base.freeResult ((Result -> IO a) -> IO a) -> (Result -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Result
r -> do
Int
ncols <- Either Connection Result -> IO Int
Base.fieldCount (Result -> Either Connection Result
forall a b. b -> Either a b
Right Result
r)
if Int
ncols Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then QueryError -> IO a
forall e a. Exception e => e -> IO a
throwIO (QueryError -> IO a) -> QueryError -> IO a
forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> QueryError
QueryError [Char]
"query resulted in zero-column result" Query
q
else Result -> [Field] -> IO a
act Result
r ([Field] -> IO a) -> IO [Field] -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Result -> IO [Field]
Base.fetchFields Result
r
withTransaction :: Connection -> IO a -> IO a
withTransaction :: forall a. Connection -> IO a -> IO a
withTransaction Connection
conn IO a
act = do
Int64
_ <- Connection -> Query -> IO Int64
execute_ Connection
conn Query
"start transaction"
a
r <- IO a
act IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` Connection -> IO ()
Base.rollback Connection
conn
Connection -> IO ()
Base.commit Connection
conn
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
fmtError :: String -> Query -> [Action] -> a
fmtError :: forall a. [Char] -> Query -> [Action] -> a
fmtError [Char]
msg Query
q [Action]
xs = FormatError -> a
forall a e. Exception e => e -> a
throw FormatError :: [Char] -> Query -> [ByteString] -> FormatError
FormatError {
fmtMessage :: [Char]
fmtMessage = [Char]
msg
, fmtQuery :: Query
fmtQuery = Query
q
, fmtParams :: [ByteString]
fmtParams = (Action -> ByteString) -> [Action] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Action -> ByteString
twiddle [Action]
xs
}
where twiddle :: Action -> ByteString
twiddle (Plain Builder
b) = Builder -> ByteString
toByteString Builder
b
twiddle (Escape ByteString
s) = ByteString
s
twiddle (Many [Action]
ys) = [ByteString] -> ByteString
B.concat ((Action -> ByteString) -> [Action] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Action -> ByteString
twiddle [Action]
ys)