{-# LANGUAGE FlexibleContexts #-}
module Database.HDBC.Record.Query (
PreparedQuery, prepare, prepareQuery, withPrepareQuery,
fetch, fetchAll',
listToUnique, fetchUnique, fetchUnique',
runStatement',
runPreparedQuery',
runQuery',
fetchAll,
runStatement,
runPreparedQuery,
runQuery,
) where
import Data.Maybe (listToMaybe)
import Database.HDBC (IConnection, Statement, SqlValue)
import qualified Database.HDBC as HDBC
import Database.Relational (Query, untypeQuery)
import Database.Record (ToSql, FromSql, toRecord)
import Database.HDBC.Record.Statement
(unsafePrepare, withUnsafePrepare, PreparedStatement,
bind, BoundStatement,
executeBound, ExecutedStatement, executed)
type PreparedQuery p a = PreparedStatement p a
prepare :: IConnection conn
=> conn
-> Query p a
-> IO (PreparedQuery p a)
prepare conn = unsafePrepare conn . untypeQuery
prepareQuery :: IConnection conn
=> conn
-> Query p a
-> IO (PreparedQuery p a)
prepareQuery = prepare
withPrepareQuery :: IConnection conn
=> conn
-> Query p a
-> (PreparedQuery p a -> IO b)
-> IO b
withPrepareQuery conn = withUnsafePrepare conn . untypeQuery
fetchRecords :: (Functor f, FromSql SqlValue a)
=> (Statement -> IO (f [SqlValue]) )
-> ExecutedStatement a
-> IO (f a)
fetchRecords fetchs es = do
rows <- fetchs (executed es)
return $ fmap toRecord rows
fetch :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
fetch = fetchRecords HDBC.fetchRow
fetchAll :: FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll = fetchRecords HDBC.fetchAllRows
fetchAll' :: FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll' = fetchRecords HDBC.fetchAllRows'
fetchUnique :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
fetchUnique es = do
recs <- fetchAll es
let z' = listToMaybe recs
z <- z' `seq` return z'
HDBC.finish $ executed es
return z
listToUnique :: [a] -> IO (Maybe a)
listToUnique = d where
d [] = return Nothing
d [r] = return $ Just r
d (_:_:_) = fail "fetchUnique': more than one record found."
fetchUnique' :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
fetchUnique' es = do
recs <- fetchAll es
z <- listToUnique recs
HDBC.finish $ executed es
return z
runStatement :: FromSql SqlValue a => BoundStatement a -> IO [a]
runStatement = (>>= fetchAll) . executeBound
runStatement' :: FromSql SqlValue a => BoundStatement a -> IO [a]
runStatement' = (>>= fetchAll') . executeBound
runPreparedQuery :: (ToSql SqlValue p, FromSql SqlValue a)
=> PreparedQuery p a
-> p
-> IO [a]
runPreparedQuery ps = runStatement . bind ps
runPreparedQuery' :: (ToSql SqlValue p, FromSql SqlValue a)
=> PreparedQuery p a
-> p
-> IO [a]
runPreparedQuery' ps = runStatement' . bind ps
runQuery :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)
=> conn
-> Query p a
-> p
-> IO [a]
runQuery conn q p = prepare conn q >>= (`runPreparedQuery` p)
runQuery' :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)
=> conn
-> Query p a
-> p
-> IO [a]
runQuery' conn q p = withPrepareQuery conn q (`runPreparedQuery'` p)