module Database.Sql.Simple.Pool where
import Control.Applicative
import Control.Monad.Trans.Control
import Data.Typeable
import Data.Default.Class
import Database.Sql.Simple.Internal
import Data.Time.Clock
import qualified Data.Pool as Pool
data Backend b => Pool b = Pool (Pool.Pool b)
deriving (Typeable)
instance Elem (Pool a) (a ': as)
data PoolConfig = PoolConfig
{ numStripes :: Int
, idleTime :: NominalDiffTime
, maxResources :: Int
} deriving (Show, Typeable)
instance Default PoolConfig where
def = PoolConfig 1 20 100
instance Backend b => Backend (Pool b) where
data ConnectInfo (Pool b) = ConnectionPool
{ poolConfig :: PoolConfig
, connectInfo :: ConnectInfo b
}
type ToRow (Pool b) = ToRow b
type FromRow (Pool b) = FromRow b
connect (ConnectionPool PoolConfig{..} ci) =
Pool <$> Pool.createPool (connect ci) close numStripes idleTime maxResources
close (Pool p) = Pool.destroyAllResources p
execute (Pool p) t q = Pool.withResource p $ \c -> execute c t q
execute_ (Pool p) t = Pool.withResource p $ \c -> execute_ c t
query (Pool p) t q = Pool.withResource p $ \c -> query c t q
query_ (Pool p) t = Pool.withResource p $ \c -> query_ c t
fold (Pool p) t q a f = Pool.withResource p $ \c -> fold c t q a f
fold_ (Pool p) t a f = Pool.withResource p $ \c -> fold_ c t a f
withPool :: (Backend b, MonadBaseControl IO m) => Pool b -> (b -> m a) -> m a
withPool (Pool p) = Pool.withResource p
transaction :: Transaction b => Pool b -> (b -> Sql c a) -> Sql c a
transaction p m = withPool p $ \c -> withTransaction c (m c)