Pool de connexion DB simultané dans Haskell

Question

Je suis un programmeur Java qui apprend Haskell.
Je travaille sur une petite application web qui utilise Happstack et qui parle à une base de données via HDBC.

J'ai écrit sélectionnez et exec fonctions et je les utilise comme ceci:

module Main where 

import Control.Exception (throw) 

import Database.HDBC 
import Database.HDBC.Sqlite3 -- just for this example, I use MySQL in production 

main = do 
    exec "CREATE TABLE IF NOT EXISTS users (name VARCHAR(80) NOT NULL)" [] 

    exec "INSERT INTO users VALUES ('John')" [] 
    exec "INSERT INTO users VALUES ('Rick')" [] 

    rows <- select "SELECT name FROM users" [] 

    let toS x = (fromSql x)::String 
    let names = map (toS . head) rows 

    print names 

Très simple que vous voyez. Il y a requête, paramètres et résultat.
La création de la connexion et la validation/restauration sont masquées dans select et exec.
C'est bien, je ne veux pas m'en soucier dans mon code "logique".

exec :: String -> [SqlValue] -> IO Integer 
exec query params = withDb $ \c -> run c query params 

select :: String -> [SqlValue] -> IO [[SqlValue]] 
select query params = withDb $ \c -> quickQuery' c query params 

withDb :: (Connection -> IO a) -> IO a 
withDb f = do 
    conn <- handleSqlError $ connectSqlite3 "users.db" 
    catchSql 
     (do r <- f conn 
      commit conn 
      disconnect conn 
      return r) 
     (\e@(SqlError _ _ m) -> do 
      rollback conn 
      disconnect conn 
      throw e) 

Mauvais points:

• une nouvelle connexion est toujours créée pour chaque appel - cela tue les performances de la charge lourde
• DB url "users.db" est codé en dur - je ne peux pas réutiliser ces fonctions à travers d'autres projets w/o édition

QUESTION 1: comment introduire un pool de connexions wi un certain nombre défini (min, max) de connexions simultanées, de sorte que les connexions seront réutilisées entre les appels select/exec?

QUESTION 2: Comment rendre la chaîne "users.db" configurable? (Comment le déplacer vers le code client?)

Cela devrait être une fonctionnalité transparente: le code utilisateur ne devrait pas nécessiter de manipulation/libération explicite de connexion.

Answer 1

QUESTION 2: Je n'ai jamais utilisé HDBC, mais j'écrirais probablement quelque chose comme ça.

trySql :: Connection -> (Connection -> IO a) -> IO a 
trySql conn f = handleSql catcher $ do 
    r <- f conn 
    commit conn 
    return r 
    where catcher e = rollback conn >> throw e 

Ouvrez le Connection quelque part en dehors de la fonction, et ne débranchez pas dans la fonction.

QUESTION 1: Hmm, un pool de connexion ne semble pas difficile à mettre en œuvre ...

import Control.Concurrent 
import Control.Exception 

data Pool a = 
    Pool { poolMin :: Int, poolMax :: Int, poolUsed :: Int, poolFree :: [a] } 

newConnPool low high newConn delConn = do 
    cs <- handleSqlError . sequence . replicate low newConn 
    mPool <- newMVar $ Pool low high 0 cs 
    return (mPool, newConn, delConn) 

delConnPool (mPool, newConn, delConn) = do 
    pool <- takeMVar mPool 
    if length (poolFree pool) /= poolUsed pool 
     then putMVar mPool pool >> fail "pool in use" 
     else mapM_ delConn $ poolFree pool 

takeConn (mPool, newConn, delConn) = modifyMVar mPool $ \pool -> 
    case poolFree pool of 
     conn:cs -> 
      return (pool { poolUsed = poolUsed pool + 1, poolFree = cs }, conn) 
     _ | poolUsed pool < poolMax pool -> do 
      conn <- handleSqlError newConn 
      return (pool { poolUsed = poolUsed pool + 1 }, conn) 
     _ -> fail "pool is exhausted" 

putConn (mPool, newConn, delConn) conn = modifyMVar_ mPool $ \pool -> 
    let used = poolUsed pool in 
    if used > poolMin conn 
     then handleSqlError (delConn conn) >> return (pool { poolUsed = used - 1 }) 
     else return $ pool { poolUsed = used - 1, poolFree = conn : poolFree pool } 

withConn connPool = bracket (takeConn connPool) (putConn conPool) 

Vous ne devriez probablement pas prendre ce mot à mot comme je l'ai même pas la compilation testé (et fail il est assez hostile), mais l'idée est de faire quelque chose comme

connPool <- newConnPool 0 50 (connectSqlite3 "user.db") disconnect 

et passer connPool autour au besoin.

Answer 2

J'ai modifié le code ci-dessus, maintenant il est capable de compiler au moins.

module ConnPool (newConnPool, withConn, delConnPool) where 

import Control.Concurrent 
import Control.Exception 
import Control.Monad (replicateM) 
import Database.HDBC 

data Pool a = 
    Pool { poolMin :: Int, poolMax :: Int, poolUsed :: Int, poolFree :: [a] } 

newConnPool :: Int -> Int -> IO a -> (a -> IO()) -> IO (MVar (Pool a), IO a, (a -> IO())) 
newConnPool low high newConn delConn = do 
-- cs <- handleSqlError . sequence . replicate low newConn 
    cs <- replicateM low newConn 
    mPool <- newMVar $ Pool low high 0 cs 
    return (mPool, newConn, delConn) 

delConnPool (mPool, newConn, delConn) = do 
    pool <- takeMVar mPool 
    if length (poolFree pool) /= poolUsed pool 
     then putMVar mPool pool >> fail "pool in use" 
     else mapM_ delConn $ poolFree pool 

takeConn (mPool, newConn, delConn) = modifyMVar mPool $ \pool -> 
    case poolFree pool of 
     conn:cs -> 
      return (pool { poolUsed = poolUsed pool + 1, poolFree = cs }, conn) 
     _ | poolUsed pool < poolMax pool -> do 
      conn <- handleSqlError newConn 
      return (pool { poolUsed = poolUsed pool + 1 }, conn) 
     _ -> fail "pool is exhausted" 

putConn :: (MVar (Pool a), IO a, (a -> IO b)) -> a -> IO() 
putConn (mPool, newConn, delConn) conn = modifyMVar_ mPool $ \pool -> 
    let used = poolUsed pool in 
    if used > poolMin pool 
    then handleSqlError (delConn conn) >> return (pool { poolUsed = used - 1 }) 
    else return $ pool { poolUsed = used - 1, poolFree = conn : (poolFree pool) } 

withConn connPool = bracket (takeConn connPool) (putConn connPool) 

Answer 3

Le paquet resource-pool fournit un pool de ressources de haute performance qui peut être utilisé pour la mise en commun de connexion de base de données.Par exemple:

import Data.Pool (createPool, withResource) 

main = do 
    pool <- createPool newConn delConn 1 10 5 
    withResource pool $ \conn -> doSomething conn 

Crée un pool de connexions de base de données avec 1 sous-pool et jusqu'à 5 connexions. Chaque connexion est autorisée à rester inactive pendant 10 secondes avant d'être détruite.