module Database.HDBC.Record.KeyUpdate (
PreparedKeyUpdate,
prepare, prepareKeyUpdate, withPrepareKeyUpdate,
bindKeyUpdate,
runPreparedKeyUpdate, runKeyUpdate
) where
import Control.Exception (bracket)
import Database.HDBC (IConnection, SqlValue, Statement)
import qualified Database.HDBC as HDBC
import Database.Relational.Query
(KeyUpdate, untypeKeyUpdate, updateValuesWithKey, Pi)
import qualified Database.Relational.Query as Query
import Database.Record (ToSql)
import Database.HDBC.Record.Statement
(BoundStatement (BoundStatement, bound, params), executeNoFetch)
data PreparedKeyUpdate p a =
PreparedKeyUpdate
{
updateKey :: Pi a p
, preparedKeyUpdate :: Statement
}
prepare :: IConnection conn
=> conn
-> KeyUpdate p a
-> IO (PreparedKeyUpdate p a)
prepare conn ku = fmap (PreparedKeyUpdate key) . HDBC.prepare conn $ sql where
sql = untypeKeyUpdate ku
key = Query.updateKey ku
prepareKeyUpdate :: IConnection conn
=> conn
-> KeyUpdate p a
-> IO (PreparedKeyUpdate p a)
prepareKeyUpdate = prepare
withPrepareKeyUpdate :: IConnection conn
=> conn
-> KeyUpdate p a
-> (PreparedKeyUpdate p a -> IO b)
-> IO b
withPrepareKeyUpdate conn ku body =
bracket (HDBC.prepare conn sql) HDBC.finish
$ body . PreparedKeyUpdate key
where
sql = untypeKeyUpdate ku
key = Query.updateKey ku
bindKeyUpdate :: ToSql SqlValue a
=> PreparedKeyUpdate p a
-> a
-> BoundStatement ()
bindKeyUpdate pre a =
BoundStatement { bound = preparedKeyUpdate pre, params = updateValuesWithKey key a }
where key = updateKey pre
runPreparedKeyUpdate :: ToSql SqlValue a
=> PreparedKeyUpdate p a
-> a
-> IO Integer
runPreparedKeyUpdate pre = executeNoFetch . bindKeyUpdate pre
runKeyUpdate :: (IConnection conn, ToSql SqlValue a)
=> conn
-> KeyUpdate p a
-> a
-> IO Integer
runKeyUpdate conn q a = withPrepareKeyUpdate conn q (`runPreparedKeyUpdate` a)