Concurrent HDBC with resource-pool

hdbc-concurrent.cabal

-- hdbc-concurrency.cabal auto-generated by cabal init. For additional
-- options, see
-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
-- The name of the package.
Name:                hdbc-concurrency

-- The package version. See the Haskell package versioning policy
-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
-- standards guiding when and how versions should be incremented.
Version:             0.1

-- A short (one-line) description of the package.
-- Synopsis:            

-- A longer description of the package.
-- Description:         

-- The license under which the package is released.
License:             BSD3

-- The file containing the license text.
License-file:        LICENSE

-- The package author(s).
Author:              paul

-- An email address to which users can send suggestions, bug reports,
-- and patches.
Maintainer:          paul

-- A copyright notice.
-- Copyright:           

Category:            Concurrency

Build-type:          Simple

-- Extra files to be distributed with the package, such as examples or
-- a README.
-- Extra-source-files:  

-- Constraint on the version of Cabal needed to build this package.
Cabal-version:       >=1.2


Executable hdbc-concurrency
  -- .hs or .lhs file containing the Main module.
  Main-is: Main.hs
  
  -- Packages needed in order to build this package.
  Build-depends: base == 4.*
               , HDBC == 2.3.*
               , HDBC-postgresql == 2.3.*
               , resource-pool == 0.2.*
  
  GHC-Options: -threaded -rtsopts
  -- Modules not exported by this package.
  -- Other-modules:       
  
  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
  -- Build-tools:         
  

Main.hs

module Main where

import Control.Monad (forever)
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan

import Data.Pool

import Database.HDBC
import Database.HDBC.PostgreSQL

n_con = 30
pool_size = 10
sleep_time = 2 :: Integer

main :: IO ()
main = do
  chan <- newChan
  pool <- createPool (connectPostgreSQL "") disconnect 1 10 pool_size
  mapM_ forkIO $ map (\n -> withResource pool $ \db -> sleep db chan n) [1..n_con]
  sequence_ $ replicate n_con $ readChan chan >>= putStrLn . show

sleep db chan n = do
  run db "SELECT pg_sleep(?);" [toSql sleep_time]
  writeChan chan n