{-# LANGUAGE CPP #-}
-- #hide
{- |
   Module     : Database.HDBC.Utils
   Copyright  : Copyright (C) 2005-2011 John Goerzen
   License    : BSD3

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

Internal module -- not exported directly.

Everything in here is expoerted by "Database.HDBC".  Please use -- and read --
"Database.HDBC" directly.

Written by John Goerzen, jgoerzen\@complete.org
-}

module Database.HDBC.Utils where
import Database.HDBC.Types
import qualified Data.Map as Map
import Control.Exception
import System.IO.Unsafe
import Data.List(genericLength)

-- import Data.Dynamic below for GHC < 6.10

#if __GLASGOW_HASKELL__ >= 610
{- | Execute the given IO action.

If it raises a 'SqlError', then execute the supplied handler and return its
return value.  Otherwise, proceed as normal. -}
catchSql :: IO a -> (SqlError -> IO a) -> IO a
catchSql :: IO a -> (SqlError -> IO a) -> IO a
catchSql IO a
action SqlError -> IO a
handler = 
    (SqlError -> Maybe SqlError) -> IO a -> (SqlError -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust SqlError -> Maybe SqlError
sqlExceptions IO a
action SqlError -> IO a
handler

{- | Like 'catchSql', with the order of arguments reversed. -}
handleSql :: (SqlError -> IO a) -> IO a -> IO a
handleSql :: (SqlError -> IO a) -> IO a -> IO a
handleSql SqlError -> IO a
h IO a
f = IO a -> (SqlError -> IO a) -> IO a
forall a. IO a -> (SqlError -> IO a) -> IO a
catchSql IO a
f SqlError -> IO a
h

{- | Given an Exception, return Just SqlError if it was an SqlError, or Nothing
otherwise. Useful with functions like catchJust. -}
sqlExceptions :: SqlError -> Maybe SqlError
sqlExceptions :: SqlError -> Maybe SqlError
sqlExceptions SqlError
e = SqlError -> Maybe SqlError
forall a. a -> Maybe a
Just SqlError
e

#else
import Data.Dynamic

{- | Execute the given IO action.

If it raises a 'SqlError', then execute the supplied handler and return its
return value.  Otherwise, proceed as normal. -}
catchSql :: IO a -> (SqlError -> IO a) -> IO a
catchSql = catchDyn

{- | Like 'catchSql', with the order of arguments reversed. -}
handleSql :: (SqlError -> IO a) -> IO a -> IO a
handleSql h f = catchDyn f h

{- | Given an Exception, return Just SqlError if it was an SqlError, or Nothing
otherwise. Useful with functions like catchJust. -}
sqlExceptions :: Exception -> Maybe SqlError
sqlExceptions e = dynExceptions e >>= fromDynamic
#endif

{- | Catches 'SqlError's, and re-raises them as IO errors with fail.
Useful if you don't care to catch SQL errors, but want to see a sane
error message if one happens.  One would often use this as a high-level
wrapper around SQL calls. -}
handleSqlError :: IO a -> IO a
handleSqlError :: IO a -> IO a
handleSqlError IO a
action =
    IO a -> (SqlError -> IO a) -> IO a
forall a. IO a -> (SqlError -> IO a) -> IO a
catchSql IO a
action SqlError -> IO a
forall (m :: * -> *) a a. (MonadFail m, Show a) => a -> m a
handler
    where handler :: a -> m a
handler a
e = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"SQL error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e)

{- | Like 'run', but take a list of Maybe Strings instead of 'SqlValue's. -}
sRun :: IConnection conn => conn -> String -> [Maybe String] -> IO Integer
sRun :: conn -> String -> [Maybe String] -> IO Integer
sRun conn
conn String
qry [Maybe String]
lst =
    conn -> String -> [SqlValue] -> IO Integer
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
run conn
conn String
qry ((Maybe String -> SqlValue) -> [Maybe String] -> [SqlValue]
forall a b. (a -> b) -> [a] -> [b]
map Maybe String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql [Maybe String]
lst)

{- | Like 'execute', but take a list of Maybe Strings instead of
   'SqlValue's. -}
sExecute :: Statement -> [Maybe String] -> IO Integer
sExecute :: Statement -> [Maybe String] -> IO Integer
sExecute Statement
sth [Maybe String]
lst = Statement -> [SqlValue] -> IO Integer
execute Statement
sth ((Maybe String -> SqlValue) -> [Maybe String] -> [SqlValue]
forall a b. (a -> b) -> [a] -> [b]
map Maybe String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql [Maybe String]
lst)

{- | Like 'executeMany', but take a list of Maybe Strings instead of
   'SqlValue's. -}
sExecuteMany :: Statement -> [[Maybe String]] -> IO ()
sExecuteMany :: Statement -> [[Maybe String]] -> IO ()
sExecuteMany Statement
sth [[Maybe String]]
lst = 
    Statement -> [[SqlValue]] -> IO ()
executeMany Statement
sth (([Maybe String] -> [SqlValue]) -> [[Maybe String]] -> [[SqlValue]]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe String -> SqlValue) -> [Maybe String] -> [SqlValue]
forall a b. (a -> b) -> [a] -> [b]
map Maybe String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql) [[Maybe String]]
lst)

{- | Like 'fetchRow', but return a list of Maybe Strings instead of
   'SqlValue's. -}
sFetchRow :: Statement -> IO (Maybe [Maybe String])
sFetchRow :: Statement -> IO (Maybe [Maybe String])
sFetchRow Statement
sth =
    do Maybe [SqlValue]
res <- Statement -> IO (Maybe [SqlValue])
fetchRow Statement
sth
       case Maybe [SqlValue]
res of
         Maybe [SqlValue]
Nothing -> Maybe [Maybe String] -> IO (Maybe [Maybe String])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Maybe String]
forall a. Maybe a
Nothing
         Just [SqlValue]
x -> Maybe [Maybe String] -> IO (Maybe [Maybe String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Maybe String] -> IO (Maybe [Maybe String]))
-> Maybe [Maybe String] -> IO (Maybe [Maybe String])
forall a b. (a -> b) -> a -> b
$ [Maybe String] -> Maybe [Maybe String]
forall a. a -> Maybe a
Just ([Maybe String] -> Maybe [Maybe String])
-> [Maybe String] -> Maybe [Maybe String]
forall a b. (a -> b) -> a -> b
$ (SqlValue -> Maybe String) -> [SqlValue] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map SqlValue -> Maybe String
forall a. Convertible SqlValue a => SqlValue -> a
fromSql [SqlValue]
x

{- | Execute some code.  If any uncaught exception occurs, run
'rollback' and re-raise it.  Otherwise, run 'commit' and return.

This function, therefore, encapsulates the logical property that a transaction
is all about: all or nothing.

The 'IConnection' object passed in is passed directly to the specified
function as a convenience.

This function traps /all/ uncaught exceptions, not just SqlErrors.  Therefore,
you will get a rollback for any exception that you don't handle.  That's
probably what you want anyway.

Since all operations in HDBC are done in a transaction, this function doesn't
issue an explicit \"begin\" to the server.  You should ideally have
called 'Database.HDBC.commit' or 'Database.HDBC.rollback' before
calling this function.  If you haven't, this function will commit or rollback
more than just the changes made in the included action.

If there was an error while running 'rollback', this error will not be
reported since the original exception will be propogated back.  (You'd probably
like to know about the root cause for all of this anyway.)  Feedback
on this behavior is solicited.
-}
withTransaction :: IConnection conn => conn -> (conn -> IO a) -> IO a
withTransaction :: conn -> (conn -> IO a) -> IO a
withTransaction conn
conn conn -> IO a
func =
#if __GLASGOW_HASKELL__ >= 610
    do a
r <- IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
onException (conn -> IO a
func conn
conn) IO ()
doRollback
       conn -> IO ()
forall conn. IConnection conn => conn -> IO ()
commit conn
conn
       a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    where doRollback :: IO ()
doRollback = 
              -- Discard any exception from (rollback conn) so original
              -- exception can be re-raised
              IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch (conn -> IO ()
forall conn. IConnection conn => conn -> IO ()
rollback conn
conn) SomeException -> IO ()
doRollbackHandler
          doRollbackHandler :: SomeException -> IO ()
          doRollbackHandler :: SomeException -> IO ()
doRollbackHandler SomeException
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
    do r <- try (func conn)
       case r of
         Right x -> do commit conn
                       return x
         Left e -> 
             do try (rollback conn) -- Discard any exception here
                throw e
#endif
{- | Lazily fetch all rows from an executed 'Statement'.

You can think of this as hGetContents applied to a database result set.

The result of this is a lazy list, and each new row will be read, lazily, from
the database as the list is processed.

When you have exhausted the list, the 'Statement' will be 'finish'ed.

Please note that the careless use of this function can lead to some unpleasant
behavior.  In particular, if you have not consumed the entire list, then
attempt to 'finish' or re-execute the statement, and then attempt to consume
more elements from the list, the result will almost certainly not be what
you want.

But then, similar caveats apply with hGetContents.

Bottom line: this is a very convenient abstraction; use it wisely.

Use 'fetchAllRows'' if you need something that is strict, without
all these caveats.
-}
fetchAllRows :: Statement -> IO [[SqlValue]]
fetchAllRows :: Statement -> IO [[SqlValue]]
fetchAllRows Statement
sth = IO [[SqlValue]] -> IO [[SqlValue]]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [[SqlValue]] -> IO [[SqlValue]])
-> IO [[SqlValue]] -> IO [[SqlValue]]
forall a b. (a -> b) -> a -> b
$
    do Maybe [SqlValue]
row <- Statement -> IO (Maybe [SqlValue])
fetchRow Statement
sth
       case Maybe [SqlValue]
row of
         Maybe [SqlValue]
Nothing -> [[SqlValue]] -> IO [[SqlValue]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
         Just [SqlValue]
x -> do [[SqlValue]]
remainder <- Statement -> IO [[SqlValue]]
fetchAllRows Statement
sth
                      [[SqlValue]] -> IO [[SqlValue]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SqlValue]
x [SqlValue] -> [[SqlValue]] -> [[SqlValue]]
forall a. a -> [a] -> [a]
: [[SqlValue]]
remainder)

evalAll :: [[a]] -> IO Integer
evalAll :: [[a]] -> IO Integer
evalAll [[a]]
inp =
    do [Integer]
r1 <- ([a] -> IO Integer) -> [[a]] -> IO [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Integer -> IO Integer
forall a. a -> IO a
evaluate (Integer -> IO Integer) -> ([a] -> Integer) -> [a] -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Integer
forall i a. Num i => [a] -> i
genericLength) [[a]]
inp
       Integer -> IO Integer
forall a. a -> IO a
evaluate ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
r1)

{- | Strict version of 'fetchAllRows'.  Does not have the side-effects
of 'fetchAllRows', but forces the entire result set to be buffered
in memory. -}
fetchAllRows' :: Statement -> IO [[SqlValue]]
fetchAllRows' :: Statement -> IO [[SqlValue]]
fetchAllRows' Statement
sth =
    do [[SqlValue]]
res <- Statement -> IO [[SqlValue]]
fetchAllRows Statement
sth
       Integer
_ <- [[SqlValue]] -> IO Integer
forall a. [[a]] -> IO Integer
evalAll [[SqlValue]]
res
       [[SqlValue]] -> IO [[SqlValue]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[SqlValue]]
res

{- | Like 'fetchAllRows', but return Maybe Strings instead of 'SqlValue's. -}
sFetchAllRows :: Statement -> IO [[Maybe String]]
sFetchAllRows :: Statement -> IO [[Maybe String]]
sFetchAllRows Statement
sth =
    do [[SqlValue]]
res <- Statement -> IO [[SqlValue]]
fetchAllRows Statement
sth
       [[Maybe String]] -> IO [[Maybe String]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Maybe String]] -> IO [[Maybe String]])
-> [[Maybe String]] -> IO [[Maybe String]]
forall a b. (a -> b) -> a -> b
$ ([SqlValue] -> [Maybe String]) -> [[SqlValue]] -> [[Maybe String]]
forall a b. (a -> b) -> [a] -> [b]
map ((SqlValue -> Maybe String) -> [SqlValue] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map SqlValue -> Maybe String
forall a. Convertible SqlValue a => SqlValue -> a
fromSql) [[SqlValue]]
res

{- | Strict version of 'sFetchAllRows'. -}
sFetchAllRows' :: Statement -> IO [[Maybe String]]
sFetchAllRows' :: Statement -> IO [[Maybe String]]
sFetchAllRows' Statement
sth =
    do [[Maybe String]]
res <- Statement -> IO [[Maybe String]]
sFetchAllRows Statement
sth
       Integer
_ <- [[Maybe String]] -> IO Integer
forall a. [[a]] -> IO Integer
evalAll [[Maybe String]]
res
       [[Maybe String]] -> IO [[Maybe String]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Maybe String]]
res

{- | Like 'fetchRow', but instead of returning a list, return an association
list from column name to value.

The keys of the column names are lowercase versions of the data returned
by 'getColumnNames'.  Please heed the warnings there.  Additionally,
results are undefined if multiple columns are returned with identical names.
-}
fetchRowAL :: Statement -> IO (Maybe [(String, SqlValue)])
fetchRowAL :: Statement -> IO (Maybe [(String, SqlValue)])
fetchRowAL Statement
sth =
    do Maybe [SqlValue]
row <- Statement -> IO (Maybe [SqlValue])
fetchRow Statement
sth
       case Maybe [SqlValue]
row of
        Maybe [SqlValue]
Nothing -> Maybe [(String, SqlValue)] -> IO (Maybe [(String, SqlValue)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(String, SqlValue)]
forall a. Maybe a
Nothing
        Just [SqlValue]
r -> do [String]
names <- Statement -> IO [String]
getColumnNames Statement
sth
                     Maybe [(String, SqlValue)] -> IO (Maybe [(String, SqlValue)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [(String, SqlValue)] -> IO (Maybe [(String, SqlValue)]))
-> Maybe [(String, SqlValue)] -> IO (Maybe [(String, SqlValue)])
forall a b. (a -> b) -> a -> b
$ [(String, SqlValue)] -> Maybe [(String, SqlValue)]
forall a. a -> Maybe a
Just ([(String, SqlValue)] -> Maybe [(String, SqlValue)])
-> [(String, SqlValue)] -> Maybe [(String, SqlValue)]
forall a b. (a -> b) -> a -> b
$ [String] -> [SqlValue] -> [(String, SqlValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names [SqlValue]
r

{- | Strict version of 'fetchRowAL'. -}
fetchRowAL' :: Statement -> IO (Maybe [(String, SqlValue)])
fetchRowAL' :: Statement -> IO (Maybe [(String, SqlValue)])
fetchRowAL' Statement
sth =
    do Maybe [(String, SqlValue)]
res <- Statement -> IO (Maybe [(String, SqlValue)])
fetchRowAL Statement
sth
       Integer
_ <- case Maybe [(String, SqlValue)]
res of
         Maybe [(String, SqlValue)]
Nothing -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
         Just [(String, SqlValue)]
x -> Integer -> IO Integer
forall a. a -> IO a
evaluate (([(String, SqlValue)] -> Integer
forall i a. Num i => [a] -> i
genericLength [(String, SqlValue)]
x)::Integer)
       Maybe [(String, SqlValue)] -> IO (Maybe [(String, SqlValue)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(String, SqlValue)]
res

{- | Similar to 'fetchRowAL', but return a Map instead of an association list.
-}
fetchRowMap :: Statement -> IO (Maybe (Map.Map String SqlValue))
fetchRowMap :: Statement -> IO (Maybe (Map String SqlValue))
fetchRowMap Statement
sth = 
    do Maybe [(String, SqlValue)]
r <- Statement -> IO (Maybe [(String, SqlValue)])
fetchRowAL Statement
sth
       case Maybe [(String, SqlValue)]
r of
              Maybe [(String, SqlValue)]
Nothing -> Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map String SqlValue)
forall a. Maybe a
Nothing
              Just [(String, SqlValue)]
x -> Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue)))
-> Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue))
forall a b. (a -> b) -> a -> b
$ Map String SqlValue -> Maybe (Map String SqlValue)
forall a. a -> Maybe a
Just (Map String SqlValue -> Maybe (Map String SqlValue))
-> Map String SqlValue -> Maybe (Map String SqlValue)
forall a b. (a -> b) -> a -> b
$ [(String, SqlValue)] -> Map String SqlValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, SqlValue)]
x

{- | Strict version of 'fetchRowMap'. -}
fetchRowMap' :: Statement -> IO (Maybe (Map.Map String SqlValue))
fetchRowMap' :: Statement -> IO (Maybe (Map String SqlValue))
fetchRowMap' Statement
sth = 
    do Maybe (Map String SqlValue)
res <- Statement -> IO (Maybe (Map String SqlValue))
fetchRowMap Statement
sth
       Integer
_ <- case Maybe (Map String SqlValue)
res of
            Maybe (Map String SqlValue)
Nothing -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
            Just Map String SqlValue
x -> Integer -> IO Integer
forall a. a -> IO a
evaluate (([(String, SqlValue)] -> Integer
forall i a. Num i => [a] -> i
genericLength (Map String SqlValue -> [(String, SqlValue)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String SqlValue
x))::Integer)
       Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map String SqlValue)
res

{- | Like 'fetchAllRows', but instead of returning a list for each
row, return an association list for each row, from column name to value.

See 'fetchRowAL' for more details. -}
fetchAllRowsAL :: Statement -> IO [[(String, SqlValue)]]
fetchAllRowsAL :: Statement -> IO [[(String, SqlValue)]]
fetchAllRowsAL Statement
sth =
    do [String]
names <- Statement -> IO [String]
getColumnNames Statement
sth
       [[SqlValue]]
rows <- Statement -> IO [[SqlValue]]
fetchAllRows Statement
sth
       [[(String, SqlValue)]] -> IO [[(String, SqlValue)]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(String, SqlValue)]] -> IO [[(String, SqlValue)]])
-> [[(String, SqlValue)]] -> IO [[(String, SqlValue)]]
forall a b. (a -> b) -> a -> b
$ ([SqlValue] -> [(String, SqlValue)])
-> [[SqlValue]] -> [[(String, SqlValue)]]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [SqlValue] -> [(String, SqlValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names) [[SqlValue]]
rows

{- | Strict version of 'fetchAllRowsAL' -}
fetchAllRowsAL' :: Statement -> IO [[(String, SqlValue)]]
fetchAllRowsAL' :: Statement -> IO [[(String, SqlValue)]]
fetchAllRowsAL' Statement
sth =
    do [[(String, SqlValue)]]
res <- Statement -> IO [[(String, SqlValue)]]
fetchAllRowsAL Statement
sth
       Integer
_ <- [[(String, SqlValue)]] -> IO Integer
forall a. [[a]] -> IO Integer
evalAll [[(String, SqlValue)]]
res
       [[(String, SqlValue)]] -> IO [[(String, SqlValue)]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[(String, SqlValue)]]
res

{- | Like 'fetchAllRowsAL', but return a list of Maps instead of a list of
association lists. -}
fetchAllRowsMap :: Statement -> IO [Map.Map String SqlValue]
fetchAllRowsMap :: Statement -> IO [Map String SqlValue]
fetchAllRowsMap Statement
sth = Statement -> IO [[(String, SqlValue)]]
fetchAllRowsAL Statement
sth IO [[(String, SqlValue)]]
-> ([[(String, SqlValue)]] -> IO [Map String SqlValue])
-> IO [Map String SqlValue]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Map String SqlValue] -> IO [Map String SqlValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Map String SqlValue] -> IO [Map String SqlValue])
-> ([[(String, SqlValue)]] -> [Map String SqlValue])
-> [[(String, SqlValue)]]
-> IO [Map String SqlValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, SqlValue)] -> Map String SqlValue)
-> [[(String, SqlValue)]] -> [Map String SqlValue]
forall a b. (a -> b) -> [a] -> [b]
map [(String, SqlValue)] -> Map String SqlValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList)

{- | Strict version of 'fetchAllRowsMap' -}
fetchAllRowsMap' :: Statement -> IO [Map.Map String SqlValue]
fetchAllRowsMap' :: Statement -> IO [Map String SqlValue]
fetchAllRowsMap' Statement
sth = 
    do [Map String SqlValue]
res <- Statement -> IO [Map String SqlValue]
fetchAllRowsMap Statement
sth
       Integer
_ <- Integer -> IO Integer
forall a. a -> IO a
evaluate (([Map String SqlValue] -> Integer
forall i a. Num i => [a] -> i
genericLength [Map String SqlValue]
res)::Integer)
       [Map String SqlValue] -> IO [Map String SqlValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [Map String SqlValue]
res

{- | A quick way to do a query.  Similar to preparing, executing, and
then calling 'fetchAllRows' on a statement. See also 'quickQuery''. -}
quickQuery :: IConnection conn => conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery :: conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery conn
conn String
qrystr [SqlValue]
args =
    do Statement
sth <- conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
prepare conn
conn String
qrystr
       Integer
_ <- Statement -> [SqlValue] -> IO Integer
execute Statement
sth [SqlValue]
args
       Statement -> IO [[SqlValue]]
fetchAllRows Statement
sth

{- | Strict version of 'quickQuery'. -}
quickQuery' :: IConnection conn => conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery' :: conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery' conn
conn String
qrystr [SqlValue]
args =
    do [[SqlValue]]
res <- conn -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery conn
conn String
qrystr [SqlValue]
args
       Integer
_ <- [[SqlValue]] -> IO Integer
forall a. [[a]] -> IO Integer
evalAll [[SqlValue]]
res
       [[SqlValue]] -> IO [[SqlValue]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[SqlValue]]
res

{- | A utility function to throw a 'SqlError'.  The mechanics of throwing
such a thing differ between GHC 6.8.x, Hugs, and GHC 6.10.  This function
takes care of the special cases to make it simpler.

With GHC 6.10, it is a type-restricted alias for throw.  On all other systems,
it is a type-restricted alias for throwDyn. -}
throwSqlError :: SqlError -> IO a
#if __GLASGOW_HASKELL__ >= 610
throwSqlError :: SqlError -> IO a
throwSqlError = SqlError -> IO a
forall a e. Exception e => e -> a
throw
#else
throwSqlError = throwDyn
#endif