{-# LANGUAGE CPP #-}
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)
#if __GLASGOW_HASKELL__ >= 610
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
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
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
catchSql :: IO a -> (SqlError -> IO a) -> IO a
catchSql = catchDyn
handleSql :: (SqlError -> IO a) -> IO a -> IO a
handleSql h f = catchDyn f h
sqlExceptions :: Exception -> Maybe SqlError
sqlExceptions e = dynExceptions e >>= fromDynamic
#endif
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)
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)
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)
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)
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
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 =
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)
throw e
#endif
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)
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
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
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
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
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
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
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
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
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
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)
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
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
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
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