module Snap.Snaplet.Hdbc.Types where
import Control.Concurrent.MVar
import Control.Monad.CatchIO
import Control.Monad.State
import Database.HDBC (IConnection())
import qualified Database.HDBC as HDBC
import Data.Pool
data HdbcSnaplet c s
= (IConnection c, ConnSrc s)
=> HdbcSnaplet
{ connSrc :: s c
, connVar :: MVar c }
class ConnSrc s where
withConn :: (MonadCatchIO m, IConnection c) => HdbcSnaplet c s -> (c -> m b) -> m b
closeConn :: (MonadCatchIO m, IConnection c) => HdbcSnaplet c s -> c -> m ()
instance ConnSrc Pool where
withConn = withResource . connSrc
closeConn _ _ = return ()
instance ConnSrc IO where
withConn st fn = do
let cv = connVar st
emp <- liftIO $ isEmptyMVar cv
conn <- if emp
then do
conn <- liftIO $ connSrc st
liftIO $ putMVar cv conn
return conn
else liftIO $ readMVar cv
fn conn
closeConn _ = liftIO . HDBC.disconnect