module Database.HDBC.Record.Statement (
PreparedStatement, untypePrepared, unsafePrepare,
BoundStatement (..), bind', bind, bindTo,
ExecutedStatement, executed, result, execute,
prepareNoFetch, executeNoFetch, runPreparedNoFetch, runNoFetch, mapNoFetch
) where
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
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
execute :: BoundStatement a -> IO (ExecutedStatement a)
execute bs = do
let stmt = bound bs
n <- HDBC.execute stmt (params bs)
return $ ExecutedStatement stmt n
executeNoFetch :: BoundStatement () -> IO Integer
executeNoFetch = fmap result . execute
runPreparedNoFetch :: ToSql SqlValue a
=> PreparedStatement a ()
-> a
-> IO Integer
runPreparedNoFetch p = executeNoFetch . (p `bind`)
runNoFetch :: (UntypeableNoFetch s, IConnection conn, ToSql SqlValue a)
=> conn
-> s a
-> a
-> IO Integer
runNoFetch conn s p = prepareNoFetch conn s >>= (`runPreparedNoFetch` p)
mapNoFetch :: (UntypeableNoFetch s, IConnection conn, ToSql SqlValue a)
=> conn
-> s a
-> [a]
-> IO [Integer]
mapNoFetch conn s rs = do
ps <- prepareNoFetch conn s
mapM (runPreparedNoFetch ps) rs