{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings #-}

-- |
-- Module:      Database.MySQL.Simple
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Paul Rouse <pyr@doynton.org>
-- Stability:   experimental
-- Portability: portable
--
-- A mid-level client library for the MySQL database, aimed at ease of
-- use and high performance.

module Database.MySQL.Simple
    (
    -- * Writing queries
    -- $use

    -- ** The Query type
    -- $querytype

    -- ** Parameter substitution
    -- $subst

    -- *** Type inference
    -- $inference

    -- ** Substituting a single parameter
    -- $only_param

    -- ** Representing a list of values
    -- $in

    -- ** Modifying multiple rows at once
    -- $many

    -- * Extracting results
    -- $result

    -- ** Handling null values
    -- $null

    -- ** Type conversions
    -- $types

    -- * Types
      Base.ConnectInfo(..)
    , Connection
    , Query
    , In(..)
    , VaArgs(..)
    , Binary(..)
    , Only(..)
    -- ** Exceptions
    , FormatError(fmtMessage, fmtQuery, fmtParams)
    , QueryError(qeMessage, qeQuery)
    , ResultError(errSQLType, errHaskellType, errMessage)
    -- * Connection management
    , Base.connect
    , Base.defaultConnectInfo
    , Base.close
    -- * Queries that return results
    , query
    , query_
    -- * Queries that stream results
    , fold
    , fold_
    , forEach
    , forEach_
    -- * Statements that do not return results
    , execute
    , execute_
    , executeMany
    , Base.insertID
    -- * Transaction handling
    , withTransaction
    , Base.autocommit
    , Base.commit
    , Base.rollback
    -- * Helper functions
    , formatMany
    , formatQuery
    , splitQuery
    ) 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, Result)
import Database.MySQL.Base.Types (Field)
import Database.MySQL.Simple.Param (Action(..), inQuotes)
import Database.MySQL.Simple.QueryParams (QueryParams(..))
import Database.MySQL.Simple.QueryResults (QueryResults(..))
import Database.MySQL.Simple.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

-- | Exception thrown if a 'Query' could not be formatted correctly.
-- This may occur if the number of \'@?@\' characters in the query
-- string does not match the number of parameters provided.
data FormatError = FormatError {
      FormatError -> String
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 -> String
(Int -> FormatError -> ShowS)
-> (FormatError -> String)
-> ([FormatError] -> ShowS)
-> Show FormatError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatError] -> ShowS
$cshowList :: [FormatError] -> ShowS
show :: FormatError -> String
$cshow :: FormatError -> String
showsPrec :: Int -> FormatError -> ShowS
$cshowsPrec :: Int -> FormatError -> ShowS
Show, Typeable)

instance Exception FormatError

-- | Exception thrown if 'query' is used to perform an @INSERT@-like
-- operation, or 'execute' is used to perform a @SELECT@-like operation.
data QueryError = QueryError {
      QueryError -> String
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 -> String
(Int -> QueryError -> ShowS)
-> (QueryError -> String)
-> ([QueryError] -> ShowS)
-> Show QueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryError] -> ShowS
$cshowList :: [QueryError] -> ShowS
show :: QueryError -> String
$cshow :: QueryError -> String
showsPrec :: Int -> QueryError -> ShowS
$cshowsPrec :: Int -> QueryError -> ShowS
Show, Typeable)

instance Exception QueryError

-- | Format a query string.
--
-- This function is exposed to help with debugging and logging. Do not
-- use it to prepare queries for execution.
--
-- String parameters are escaped according to the character set in use
-- on the 'Connection'.
--
-- Throws 'FormatError' if the query string could not be formatted
-- correctly.
formatQuery :: QueryParams q => Connection -> Query -> q -> IO ByteString
formatQuery :: 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

-- | Format a query string with a variable number of rows.
--
-- This function is exposed to help with debugging and logging. Do not
-- use it to prepare queries for execution.
--
-- The query string must contain exactly one substitution group,
-- identified by the SQL keyword \"@VALUES@\" (case insensitive)
-- followed by an \"@(@\" character, a series of one or more \"@?@\"
-- characters separated by commas, and a \"@)@\" character. White
-- space in a substitution group is permitted.
--
-- Throws 'FormatError' if the query string could not be formatted
-- correctly.
formatMany :: (QueryParams q) => Connection -> Query -> [q] -> IO ByteString
formatMany :: Connection -> Query -> [q] -> IO ByteString
formatMany Connection
_ Query
q [] = String -> Query -> [Action] -> IO ByteString
forall a. String -> Query -> [Action] -> a
fmtError String
"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]
_ -> String -> Query -> [Action] -> IO ByteString
forall a. String -> Query -> [Action] -> a
fmtError String
"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 p. Monoid p => [p] -> [p] -> p
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 :: [p] -> [p] -> p
zipParams (p
t:[p]
ts) (p
p:[p]
ps) = p
t p -> p -> p
forall a. Monoid a => a -> a -> a
`mappend` p
p p -> p -> p
forall a. Monoid a => a -> a -> a
`mappend` [p] -> [p] -> p
zipParams [p]
ts [p]
ps
        zipParams [p
t] []        = p
t
        zipParams [p]
_ [p]
_ = String -> Query -> [Action] -> p
forall a. String -> Query -> [Action] -> a
fmtError (Int -> String
forall a. Show a => a -> String
show Int
fragmentCount String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                  String
" '?' characters, but " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                  Int -> String
forall a. Show a => a -> String
show ([Action] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Action]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" 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

-- | Split a query into fragments separated by @?@ characters. Does not
-- break a fragment if the question mark is in a string literal.
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
$ (String -> Builder) -> [String] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Builder
fromByteString (ByteString -> Builder)
-> (String -> ByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString) -> ShowS -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) ([String] -> [Builder]) -> [String] -> [Builder]
forall a b. (a -> b) -> a -> b
$
    String -> String -> [String]
begin [] (ByteString -> String
BS.unpack ByteString
s)
  where
  begin :: String -> String -> [String]
begin = [String] -> String -> String -> [String]
normal []

  normal :: [String] -> String -> String -> [String]
normal [String]
ret String
acc [] =
    String
acc String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ret
  normal [String]
ret String
acc (Char
c : String
cs) =
    case Char
c of
      Char
'?' ->
        [String] -> String -> String -> [String]
normal (String
acc String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ret) [] String
cs
      Char
'\'' ->
        [String] -> String -> String -> [String]
quotes [String]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) String
cs
      Char
_ ->
        [String] -> String -> String -> [String]
normal [String]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) String
cs

  quotes :: [String] -> String -> String -> [String]
quotes [String]
ret String
acc [] =
    String
acc String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ret
  quotes [String]
ret String
acc (Char
c : String
cs) =
    case Char
c of
      Char
'\'' ->
        [String] -> String -> String -> [String]
normal [String]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) String
cs
      Char
_ ->
        [String] -> String -> String -> [String]
quotes [String]
ret (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) String
cs

-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not
-- expected to return results.
--
-- Returns the number of rows affected.
--
-- Throws 'FormatError' if the query could not be formatted correctly.
execute :: (QueryParams q) => Connection -> Query -> q -> IO Int64
execute :: 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

-- | A version of 'execute' that does not perform query substitution.
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

-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not
-- expected to return results.
--
-- Returns the number of rows affected.
--
-- Throws 'FormatError' if the query could not be formatted correctly.
executeMany :: (QueryParams q) => Connection -> Query -> [q] -> IO Int64
executeMany :: 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
$ String -> Query -> QueryError
QueryError (String
"execute resulted in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ncols String -> ShowS
forall a. [a] -> [a] -> [a]
++
                               String
"-column result") Query
q
    else Connection -> IO Int64
Base.affectedRows Connection
conn

-- | Perform a @SELECT@ or other SQL query that is expected to return
-- results. All results are retrieved and converted before this
-- function returns.
--
-- When processing large results, this function will consume a lot of
-- client-side memory.  Consider using 'fold' instead.
--
-- Exceptions that may be thrown:
--
-- * 'FormatError': the query string could not be formatted correctly.
--
-- * 'QueryError': the result contains no columns (i.e. you should be
--   using 'execute' instead of 'query').
--
-- * 'ResultError': result conversion failed.
query :: (QueryParams q, QueryResults r)
         => Connection -> Query -> q -> IO [r]
query :: 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

-- | A version of 'query' that does not perform query substitution.
query_ :: (QueryResults r) => Connection -> Query -> IO [r]
query_ :: 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

-- | Perform a @SELECT@ or other SQL query that is expected to return
-- results. Results are streamed incrementally from the server, and
-- consumed via a left fold.
--
-- The result consumer must be carefully written to execute
-- quickly. If the consumer is slow, server resources will be tied up,
-- and other clients may not be able to update the tables from which
-- the results are being streamed.
--
-- When dealing with small results, it may be simpler (and perhaps
-- faster) to use 'query' instead.
--
-- This fold is /not/ strict. The stream consumer is responsible for
-- forcing the evaluation of its result to avoid space leaks.
--
-- Exceptions that may be thrown:
--
-- * 'FormatError': the query string could not be formatted correctly.
--
-- * 'QueryError': the result contains no columns (i.e. you should be
--   using 'execute' instead of 'query').
--
-- * 'ResultError': result conversion failed.
fold :: (QueryParams q, QueryResults r) =>
        Connection
     -> Query                   -- ^ Query template.
     -> q                       -- ^ Query parameters.
     -> a                       -- ^ Initial state for result consumer.
     -> (a -> r -> IO a)        -- ^ Result consumer.
     -> IO a
fold :: 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

-- | A version of 'fold' that does not perform query substitution.
fold_ :: (QueryResults r) =>
         Connection
      -> Query                  -- ^ Query.
      -> a                      -- ^ Initial state for result consumer.
      -> (a -> r -> IO a)       -- ^ Result consumer.
      -> IO a
fold_ :: 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

-- | A version of 'fold' that does not transform a state value.
forEach :: (QueryParams q, QueryResults r) =>
           Connection
        -> Query                -- ^ Query template.
        -> q                    -- ^ Query parameters.
        -> (r -> IO ())         -- ^ Result consumer.
        -> IO ()
forEach :: 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 #-}

-- | A version of 'forEach' that does not perform query substitution.
forEach_ :: (QueryResults r) =>
            Connection
         -> Query                -- ^ Query template.
         -> (r -> IO ())         -- ^ Result consumer.
         -> IO ()
forEach_ :: 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 :: 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 :: 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 Result) -> Query -> (Result -> [Field] -> IO a) -> IO a
withResult :: 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
$ String -> Query -> QueryError
QueryError String
"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

-- | Execute an action inside a SQL transaction.
--
-- This function initiates a transaction with a \"@begin
-- transaction@\" statement, then executes the supplied action.  If
-- the action succeeds, the transaction will be completed with
-- 'Base.commit' before this function returns.
--
-- If the action throws /any/ kind of exception (not just a
-- MySQL-related exception), the transaction will be rolled back using
-- 'Base.rollback', then the exception will be rethrown.
withTransaction :: Connection -> IO a -> IO a
withTransaction :: 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 :: String -> Query -> [Action] -> a
fmtError String
msg Query
q [Action]
xs = FormatError -> a
forall a e. Exception e => e -> a
throw FormatError :: String -> Query -> [ByteString] -> FormatError
FormatError {
                      fmtMessage :: String
fmtMessage = String
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)

-- $use
--
-- SQL-based applications are somewhat notorious for their
-- susceptibility to attacks through the injection of maliciously
-- crafted data. The primary reason for widespread vulnerability to
-- SQL injections is that many applications are sloppy in handling
-- user data when constructing SQL queries.
--
-- This library provides a 'Query' type and a parameter substitution
-- facility to address both ease of use and security.

-- $querytype
--
-- A 'Query' is a @newtype@-wrapped 'ByteString'. It intentionally
-- exposes a tiny API that is not compatible with the 'ByteString'
-- API; this makes it difficult to construct queries from fragments of
-- strings.  The 'query' and 'execute' functions require queries to be
-- of type 'Query'.
--
-- To most easily construct a query, enable GHC's @OverloadedStrings@
-- language extension and write your query as a normal literal string.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > import Database.MySQL.Simple
-- >
-- > hello :: IO Int
-- > hello = do
-- >   conn <- connect defaultConnectInfo
-- >   [Only i] <- query_ conn "select 2 + 2"
-- >   return i
--
-- A 'Query' value does not represent the actual query that will be
-- executed, but is a template for constructing the final query.

-- $subst
--
-- Since applications need to be able to construct queries with
-- parameters that change, this library provides a query substitution
-- capability.
--
-- The 'Query' template accepted by 'query' and 'execute' can contain
-- any number of \"@?@\" characters.  Both 'query' and 'execute'
-- accept a third argument, typically a tuple. When constructing the
-- real query to execute, these functions replace the first \"@?@\" in
-- the template with the first element of the tuple, the second
-- \"@?@\" with the second element, and so on. If necessary, each
-- tuple element will be quoted and escaped prior to substitution;
-- this defeats the single most common injection vector for malicious
-- data.
--
-- For example, given the following 'Query' template:
--
-- > select * from user where first_name = ? and age > ?
--
-- And a tuple of this form:
--
-- > ("Boris" :: String, 37 :: Int)
--
-- The query to be executed will look like this after substitution:
--
-- > select * from user where first_name = 'Boris' and age > 37
--
-- If there is a mismatch between the number of \"@?@\" characters in
-- your template and the number of elements in your tuple, a
-- 'FormatError' will be thrown.
--
-- Note that the substitution functions do not attempt to parse or
-- validate your query. It's up to you to write syntactically valid
-- SQL, and to ensure that each \"@?@\" in your query template is
-- matched with the right tuple element.

-- $inference
--
-- Automated type inference means that you will often be able to avoid
-- supplying explicit type signatures for the elements of a tuple.
-- However, sometimes the compiler will not be able to infer your
-- types. Consider a care where you write a numeric literal in a
-- parameter tuple:
--
-- > query conn "select ? + ?" (40,2)
--
-- The above query will be rejected by the compiler, because it does
-- not know the specific numeric types of the literals @40@ and @2@.
-- This is easily fixed:
--
-- > query conn "select ? + ?" (40 :: Double, 2 :: Double)
--
-- The same kind of problem can arise with string literals if you have
-- the @OverloadedStrings@ language extension enabled.  Again, just
-- use an explicit type signature if this happens.
--
-- Finally, remember that the compiler must be able to infer the type
-- of a query's /results/ as well as its parameters.  We might like
-- the following example to work:
--
-- > print =<< query_ conn "select 2 + 2"
--
-- Unfortunately, while a quick glance tells us that the result type
-- should be a single row containing a single numeric column, the
-- compiler has no way to infer what the types are.  We can easily fix
-- this by providing an explicit type annotation:
--
-- > xs <- query_ conn "select 2 + 2"
-- > print (xs :: [Only Int])


-- $only_param
--
-- Haskell lacks a single-element tuple type, so if you have just one
-- value you want substituted into a query or a single-column result,
-- what should you do?
--
-- The obvious approach would appear to be something like this:
--
-- > instance (Param a) => QueryParam a where
-- >     ...
--
-- Unfortunately, this wreaks havoc with type inference, so we take a
-- different tack. To represent a single value @val@ as a parameter,
-- write a singleton list @[val]@, use 'Just' @val@, or use 'Only'
-- @val@.
--
-- Here's an example using a singleton list:
--
-- > execute conn "insert into users (first_name) values (?)"
-- >              ["Nuala"]
--
-- A row of /n/ query results is represented using an /n/-tuple, so
-- you should use 'Only' to represent a single-column result.

-- $in
--
-- Suppose you want to write a query using an @IN@ clause:
--
-- > select * from users where first_name in ('Anna', 'Boris', 'Carla')
--
-- In such cases, it's common for both the elements and length of the
-- list after the @IN@ keyword to vary from query to query.
--
-- To address this case, use the 'In' type wrapper, and use a single
-- \"@?@\" character to represent the list.  Omit the parentheses
-- around the list; these will be added for you.
--
-- Here's an example:
--
-- > query conn "select * from users where first_name in ?" $
-- >       In ["Anna", "Boris", "Carla"]
--
-- If your 'In'-wrapped list is empty, the string @\"(null)\"@ will be
-- substituted instead, to ensure that your clause remains
-- syntactically valid.

-- $many
--
-- If you know that you have many rows of data to insert into a table,
-- it is much more efficient to perform all the insertions in a single
-- multi-row @INSERT@ statement than individually.
--
-- The 'executeMany' function is intended specifically for helping
-- with multi-row @INSERT@ and @UPDATE@ statements. Its rules for
-- query substitution are different than those for 'execute'.
--
-- What 'executeMany' searches for in your 'Query' template is a
-- single substring of the form:
--
-- > values (?,?,?)
--
-- The rules are as follows:
--
-- * The keyword @VALUES@ is matched case insensitively.
--
-- * There must be no other \"@?@\" characters anywhere in your
--   template.
--
-- * There must one or more \"@?@\" in the parentheses.
--
-- * Extra white space is fine.
--
-- The last argument to 'executeMany' is a list of parameter
-- tuples. These will be substituted into the query where the @(?,?)@
-- string appears, in a form suitable for use in a multi-row @INSERT@
-- or @UPDATE@.
--
-- Here is an example:
--
-- > executeMany conn
-- >   "insert into users (first_name,last_name) values (?,?)"
-- >   [("Boris","Karloff"),("Ed","Wood")]
--
-- The query that will be executed here will look like this
-- (reformatted for tidiness):
--
-- > insert into users (first_name,last_name) values
-- >   ('Boris','Karloff'),('Ed','Wood')

-- $result
--
-- The 'query' and 'query_' functions return a list of values in the
-- 'QueryResults' typeclass. This class performs automatic extraction
-- and type conversion of rows from a query result.
--
-- Here is a simple example of how to extract results:
--
-- > import qualified Data.Text as Text
-- >
-- > xs <- query_ conn "select name,age from users"
-- > forM_ xs $ \(name,age) ->
-- >   putStrLn $ Text.unpack name ++ " is " ++ show (age :: Int)
--
-- Notice two important details about this code:
--
-- * The number of columns we ask for in the query template must
--   exactly match the number of elements we specify in a row of the
--   result tuple.  If they do not match, a 'ResultError' exception
--   will be thrown.
--
-- * Sometimes, the compiler needs our help in specifying types. It
--   can infer that @name@ must be a 'Text', due to our use of the
--   @unpack@ function. However, we have to tell it the type of @age@,
--   as it has no other information to determine the exact type.

-- $null
--
-- The type of a result tuple will look something like this:
--
-- > (Text, Int, Int)
--
-- Although SQL can accommodate @NULL@ as a value for any of these
-- types, Haskell cannot. If your result contains columns that may be
-- @NULL@, be sure that you use 'Maybe' in those positions of of your
-- tuple.
--
-- > (Text, Maybe Int, Int)
--
-- If 'query' encounters a @NULL@ in a row where the corresponding
-- Haskell type is not 'Maybe', it will throw a 'ResultError'
-- exception.

-- $only_result
--
-- To specify that a query returns a single-column result, use the
-- 'Only' type.
--
-- > xs <- query_ conn "select id from users"
-- > forM_ xs $ \(Only dbid) -> {- ... -}

-- $types
--
-- Conversion of SQL values to Haskell values is somewhat
-- permissive. Here are the rules.
--
-- * For numeric types, any Haskell type that can accurately represent
--   all values of the given MySQL type is considered \"compatible\".
--   For instance, you can always extract a MySQL @TINYINT@ column to
--   a Haskell 'Int'.  The Haskell 'Float' type can accurately
--   represent MySQL integer types of size up to @INT24@, so it is
--   considered compatible with those types.
--
-- * A numeric compatibility check is based only on the type of a
--   column, /not/ on its values. For instance, a MySQL @LONG_LONG@
--   column will be considered incompatible with a Haskell 'Int8',
--   even if it contains the value @1@.
--
-- * If a numeric incompatibility is found, 'query' will throw a
--   'ResultError'.
--
-- * The 'String' and 'Text' types are assumed to be encoded as
--   UTF-8. If you use some other encoding, decoding may fail or give
--   wrong results. In such cases, write a @newtype@ wrapper and a
--   custom 'Result' instance to handle your encoding.