{-# LANGUAGE FlexibleContexts #-}
module Database.HDBC.Record.Statement (
PreparedStatement, untypePrepared, unsafePrepare, finish,
withUnsafePrepare, withPrepareNoFetch,
BoundStatement (..), bind, bindTo,
ExecutedStatement, executed, result,
executeBound, execute, executePrepared,
prepareNoFetch,
executeBoundNoFetch, executeNoFetch, runPreparedNoFetch,
runNoFetch, mapNoFetch,
) where
import Control.Exception (bracket)
import Database.Relational (UntypeableNoFetch (untypeNoFetch))
import Database.HDBC (IConnection, Statement, SqlValue)
import qualified Database.HDBC as HDBC
import Database.Record (ToSql, fromRecord)
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 :: ToSql SqlValue p
=> PreparedStatement p a
-> p
-> BoundStatement a
bind q p = BoundStatement { bound = prepared q, params = fromRecord p }
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)
n `seq` return (ExecutedStatement stmt n)
{-# WARNING execute "Use 'executeBound' instead of this. This name will be used for executePrepared function in future release." #-}
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
{-# WARNING executeNoFetch "Use 'executeBoundNoFetch' instead of this. This name will be used for runPreparedNoFetch function in future release." #-}
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)