module Database.HDBC.Record.Statement (
PreparedStatement, untypePrepared, unsafePrepare, finish,
withUnsafePrepare, withPrepareNoFetch,
BoundStatement (..), bind', bind, bindTo,
ExecutedStatement, executed, result,
executeBound, execute, executePrepared,
prepareNoFetch,
executeBoundNoFetch, executeNoFetch, runPreparedNoFetch,
runNoFetch, mapNoFetch,
) where
import Control.Exception (bracket)
import Database.Relational.Query (UntypeableNoFetch (untypeNoFetch))
import Database.HDBC (IConnection, Statement, SqlValue)
import qualified Database.HDBC as HDBC
import Database.Record
(RecordToSql, ToSql(recordToSql), runFromRecord)
newtype PreparedStatement p a =
PreparedStatement {
prepared :: Statement
}
data BoundStatement a =
BoundStatement
{
bound :: Statement
, params :: [SqlValue]
}
data ExecutedStatement a =
ExecutedStatement
{
executed :: Statement
, result :: Integer
}
untypePrepared :: PreparedStatement p a -> Statement
untypePrepared = prepared
unsafePrepare :: IConnection conn
=> conn
-> String
-> IO (PreparedStatement p a)
unsafePrepare conn = fmap PreparedStatement . HDBC.prepare conn
prepareNoFetch :: (UntypeableNoFetch s, IConnection conn)
=> conn
-> s p
-> IO (PreparedStatement p ())
prepareNoFetch conn = unsafePrepare conn . untypeNoFetch
finish :: PreparedStatement p a -> IO ()
finish = HDBC.finish . prepared
withUnsafePrepare :: IConnection conn
=> conn
-> String
-> (PreparedStatement p a -> IO b)
-> IO b
withUnsafePrepare conn qs =
bracket (unsafePrepare conn qs) finish
withPrepareNoFetch :: (UntypeableNoFetch s, IConnection conn)
=> conn
-> s p
-> (PreparedStatement p () -> IO a)
-> IO a
withPrepareNoFetch conn s =
bracket (prepareNoFetch conn s) finish
bind' :: RecordToSql SqlValue p
-> PreparedStatement p a
-> p
-> BoundStatement a
bind' toSql q p = BoundStatement { bound = prepared q, params = runFromRecord toSql p }
bind :: ToSql SqlValue p => PreparedStatement p a -> p -> BoundStatement a
bind = bind' recordToSql
bindTo :: ToSql SqlValue p => p -> PreparedStatement p a -> BoundStatement a
bindTo = flip bind
executeBound :: BoundStatement a -> IO (ExecutedStatement a)
executeBound bs = do
let stmt = bound bs
n <- HDBC.execute stmt (params bs)
return $ ExecutedStatement stmt n
execute :: BoundStatement a -> IO (ExecutedStatement a)
execute = executeBound
executePrepared :: ToSql SqlValue p => PreparedStatement p a -> p -> IO (ExecutedStatement a)
executePrepared st = executeBound . bind st
executeBoundNoFetch :: BoundStatement () -> IO Integer
executeBoundNoFetch = fmap result . executeBound
executeNoFetch :: BoundStatement () -> IO Integer
executeNoFetch = executeBoundNoFetch
runPreparedNoFetch :: ToSql SqlValue a
=> PreparedStatement a ()
-> a
-> IO Integer
runPreparedNoFetch p = executeBoundNoFetch . (p `bind`)
runNoFetch :: (UntypeableNoFetch s, IConnection conn, ToSql SqlValue a)
=> conn
-> s a
-> a
-> IO Integer
runNoFetch conn s p = withPrepareNoFetch conn s (`runPreparedNoFetch` p)
mapNoFetch :: (UntypeableNoFetch s, IConnection conn, ToSql SqlValue a)
=> conn
-> s a
-> [a]
-> IO [Integer]
mapNoFetch conn s rs =
withPrepareNoFetch conn s (\ps -> mapM (runPreparedNoFetch ps) rs)