module Snap.Snaplet.Hdbc (
HdbcSnaplet(..)
, HasHdbc(..)
, HdbcIO
, HdbcPool
, Row
, 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.Concurrent.MVar
import Control.Exception (SomeException)
import Control.Monad.CatchIO
import Control.Monad.IO.Class
import Data.Map (Map)
import Data.Pool
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
, MonadCatchIO m
)
=> HasHdbc m c s | m -> c s where
getHdbcState :: m (HdbcSnaplet c s)
type HdbcIO c = HdbcSnaplet c IO
type HdbcPool c = HdbcSnaplet c Pool
hdbcInit
:: ( ConnSrc s
, IConnection c
)
=> s c
-> SnapletInit b (HdbcSnaplet c s)
hdbcInit src = makeSnaplet "hdbc" "HDBC abstraction" Nothing $ do
mv <- liftIO newEmptyMVar
return $ HdbcSnaplet src mv
withHdbc :: HasHdbc m c s => (c -> IO a) -> m a
withHdbc f = do
st <- getHdbcState
withConn st (liftIO . f)
withHdbc' :: HasHdbc m c s => (c -> a) -> m a
withHdbc' f = do
st <- getHdbcState
withConn st (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 $ \conn -> do
stmt <- HDBC.prepare conn 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 <- action `onException` doRollback
commit
return r
where doRollback = rollback `catch` doRollbackHandler
doRollbackHandler :: MonadCatchIO 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)