{-# LANGUAGE Rank2Types #-}
module Database.HDBC.Session (
transaction,
withConnectionIO, withConnectionIO_,
bracketConnection,
showSqlError, handleSqlError',
withConnection,
withConnectionIO',
withConnectionCommit,
) where
import Database.HDBC (IConnection, handleSql,
SqlError(seState, seNativeError, seErrorMsg))
import qualified Database.HDBC as HDBC
import Control.Exception (bracket)
showSqlError :: SqlError -> String
showSqlError :: SqlError -> String
showSqlError SqlError
se = [String] -> String
unlines
[String
"seState: '" forall a. [a] -> [a] -> [a]
++ SqlError -> String
seState SqlError
se forall a. [a] -> [a] -> [a]
++ String
"'",
String
"seNativeError: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SqlError -> Int
seNativeError SqlError
se),
String
"seErrorMsg: '" forall a. [a] -> [a] -> [a]
++ SqlError -> String
seErrorMsg SqlError
se forall a. [a] -> [a] -> [a]
++ String
"'"]
handleSqlError' :: IO a -> IO a
handleSqlError' :: forall a. IO a -> IO a
handleSqlError' = forall a. (SqlError -> IO a) -> IO a -> IO a
handleSql (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
reformat forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlError -> String
showSqlError) where
reformat :: String -> String
reformat = (String
"SQL error: \n" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
" " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
bracketConnection :: (Monad m, IConnection conn)
=> (forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b)
-> IO conn
-> (conn -> m a)
-> m a
bracketConnection :: forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
bracketConnection forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
bracket_ forall b. IO b -> m b
lift IO conn
connect conn -> m a
tbody =
forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
bracket_ (forall b. IO b -> m b
lift IO conn
open) (forall b. IO b -> m b
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall conn. IConnection conn => conn -> IO ()
close) conn -> m a
bodyWithRollback
where
open :: IO conn
open = forall a. IO a -> IO a
handleSqlError' IO conn
connect
close :: IConnection conn => conn -> IO ()
close :: forall conn. IConnection conn => conn -> IO ()
close = forall a. IO a -> IO a
handleSqlError' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall conn. IConnection conn => conn -> IO ()
HDBC.disconnect
bodyWithRollback :: conn -> m a
bodyWithRollback conn
conn =
forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
bracket_
(forall (m :: * -> *) a. Monad m => a -> m a
return ())
(forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. IO b -> m b
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
handleSqlError' forall a b. (a -> b) -> a -> b
$ forall conn. IConnection conn => conn -> IO ()
HDBC.rollback conn
conn)
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ conn -> m a
tbody conn
conn)
{-# DEPRECATED withConnection "use 'bracketConnection' instead of this." #-}
withConnection :: (Monad m, IConnection conn)
=> (forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b)
-> IO conn
-> (conn -> m a)
-> m a
withConnection :: forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
withConnection = forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
bracketConnection
withConnectionIO_ :: IConnection conn
=> IO conn
-> (conn -> IO a)
-> IO a
withConnectionIO_ :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO_ = forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
bracketConnection forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket forall a. a -> a
id
withConnectionIO :: IConnection conn
=> IO conn
-> (conn -> IO a)
-> IO a
withConnectionIO :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO IO conn
connect conn -> IO a
body = forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO_ IO conn
connect forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
handleSqlError' forall b c a. (b -> c) -> (a -> b) -> a -> c
. conn -> IO a
body
{-# DEPRECATED withConnectionIO' "use 'withConnectionIO' instead of this." #-}
withConnectionIO' :: IConnection conn
=> IO conn
-> (conn -> IO a)
-> IO a
withConnectionIO' :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO' = forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO
transaction :: IConnection conn
=> IO conn
-> (conn -> IO a)
-> IO a
transaction :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
transaction IO conn
conn conn -> IO a
body =
forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO IO conn
conn forall a b. (a -> b) -> a -> b
$ \conn
c -> do
a
x <- conn -> IO a
body conn
c
forall conn. IConnection conn => conn -> IO ()
HDBC.commit conn
c
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
{-# DEPRECATED withConnectionCommit "use 'transaction' instead of this." #-}
withConnectionCommit :: IConnection conn
=> IO conn
-> (conn -> IO a)
-> IO a
withConnectionCommit :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionCommit IO conn
conn conn -> IO a
body =
forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO_ IO conn
conn forall a b. (a -> b) -> a -> b
$ \conn
c -> do
a
x <- conn -> IO a
body conn
c
forall conn. IConnection conn => conn -> IO ()
HDBC.commit conn
c
forall (m :: * -> *) a. Monad m => a -> m a
return a
x