module Snap.Snaplet.Hdbc (
HdbcSnaplet(..)
, HasHdbc(..)
, hdbcInit
, query
, query'
, clone
, commit
, dbServerVer
, dbTransactionSupport
, describeTable
, disconnect
, getTables
, hdbcClientVer
, hdbcDriverName
, prepare
, proxiedClientName
, proxiedClientVer
, quickQuery
, quickQuery'
, rollback
, run
, runRaw
, sRun
, withHdbc
, withHdbc'
, withTransaction
, withTransaction'
, SqlValue(..)
, HDBC.toSql
, HDBC.fromSql
, HDBC.safeFromSql
, HDBC.nToSql
, HDBC.iToSql
, HDBC.posixToSql
, HDBC.withWConn
, Statement(..)
, HDBC.sExecute
, HDBC.sExecuteMany
, HDBC.fetchRowAL
, HDBC.fetchRowMap
, HDBC.sFetchRow
, HDBC.fetchAllRows
, HDBC.fetchAllRows'
, HDBC.fetchAllRowsAL
, HDBC.fetchAllRowsAL'
, HDBC.fetchAllRowsMap
, HDBC.fetchAllRowsMap'
, HDBC.sFetchAllRows
, HDBC.sFetchAllRows'
, SqlError(..)
, HDBC.throwSqlError
, HDBC.catchSql
, HDBC.handleSql
, HDBC.sqlExceptions
, HDBC.handleSqlError
, module Database.HDBC.ColTypes
) where
import Prelude hiding (catch)
import Control.Exception.Control hiding (Handler)
import Control.Monad.IO.Control
import Control.Monad.State
import Data.Map (Map)
import qualified Database.HDBC as HDBC
import Database.HDBC (IConnection(), SqlValue, SqlError, Statement)
import Database.HDBC.ColTypes
import Snap.Snaplet
import Snap.Snaplet.Hdbc.Types
type Row = Map String SqlValue
class (IConnection c, ConnSrc s, MonadControlIO m)
=> HasHdbc m c s | m -> c s where
getConnSrc :: m (s c)
instance MonadControlIO (Handler b v) where
liftControlIO f = liftIO (f return)
data HdbcSnaplet c s
= (IConnection c, ConnSrc s)
=> HdbcSnaplet
{ connSrc :: s c }
hdbcInit
:: (ConnSrc s, IConnection c)
=> s c
-> SnapletInit b (HdbcSnaplet c s)
hdbcInit src = makeSnaplet "hdbc" "HDBC abstraction" Nothing $
return $ HdbcSnaplet src
withHdbc :: HasHdbc m c s => (c -> IO a) -> m a
withHdbc f = do
pl <- getConnSrc
withConn pl (liftIO . f)
withHdbc' :: HasHdbc m c s => (c -> a) -> m a
withHdbc' f = do
pl <- getConnSrc
withConn pl (return . f)
query
:: HasHdbc m c s
=> String
-> [SqlValue]
-> m [Row]
query sql bind = do
stmt <- prepare sql
liftIO $ HDBC.execute stmt bind
liftIO $ HDBC.fetchAllRowsMap stmt
query' :: HasHdbc m c s => String -> [SqlValue] -> m Integer
query' sql bind = withTransaction' $ do
stmt <- prepare sql
liftIO $ HDBC.execute stmt bind
withTransaction :: HasHdbc m c s => (c -> IO a) -> m a
withTransaction f = withHdbc (`HDBC.withTransaction` f)
withTransaction' :: HasHdbc m c s => m a -> m a
withTransaction' action = do
r <- onException action doRollback
commit
return r
where doRollback = catch rollback doRollbackHandler
doRollbackHandler :: MonadControlIO m => SomeException -> m ()
doRollbackHandler _ = return ()
disconnect :: HasHdbc m c s => m ()
disconnect = withHdbc HDBC.disconnect
commit :: HasHdbc m c s => m ()
commit = withHdbc HDBC.commit
rollback :: HasHdbc m c s => m ()
rollback = withHdbc HDBC.rollback
runRaw :: HasHdbc m c s => String -> m ()
runRaw str = withHdbc (`HDBC.runRaw` str)
run :: HasHdbc m c s => String -> [SqlValue] -> m Integer
run str vs = withHdbc (\conn -> HDBC.run conn str vs)
prepare :: HasHdbc m c s => String -> m Statement
prepare str = withHdbc (`HDBC.prepare` str)
clone :: HasHdbc m c s => m c
clone = withHdbc HDBC.clone
hdbcDriverName :: HasHdbc m c s => m String
hdbcDriverName = withHdbc' HDBC.hdbcDriverName
hdbcClientVer :: HasHdbc m c s => m String
hdbcClientVer = withHdbc' HDBC.hdbcClientVer
proxiedClientName :: HasHdbc m c s => m String
proxiedClientName = withHdbc' HDBC.proxiedClientName
proxiedClientVer :: HasHdbc m c s => m String
proxiedClientVer = withHdbc' HDBC.proxiedClientVer
dbServerVer :: HasHdbc m c s => m String
dbServerVer = withHdbc' HDBC.dbServerVer
dbTransactionSupport :: HasHdbc m c s => m Bool
dbTransactionSupport = withHdbc' HDBC.dbTransactionSupport
getTables :: HasHdbc m c s => m [String]
getTables = withHdbc HDBC.getTables
describeTable :: HasHdbc m c s => String -> m [(String, SqlColDesc)]
describeTable str = withHdbc (`HDBC.describeTable` str)
quickQuery' :: HasHdbc m c s => String -> [SqlValue] -> m [[SqlValue]]
quickQuery' str vs = withHdbc (\conn -> HDBC.quickQuery' conn str vs)
quickQuery :: HasHdbc m c s => String -> [SqlValue] -> m [[SqlValue]]
quickQuery str vs = withHdbc (\conn -> HDBC.quickQuery conn str vs)
sRun :: HasHdbc m c s => String -> [Maybe String] -> m Integer
sRun str mstrs = withHdbc (\conn -> HDBC.sRun conn str mstrs)