Pool di connessioni DB simultanee in Haskell

Question

Sono un programmatore Java che impara Haskell.
Lavoro su una piccola web-app che utilizza Happstack e dialoga con un database tramite HDBC.

ho scritto selezionare e exec funzioni e le uso come questo:

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 

Molto semplice, come si vede. C'è query, parametri e risultato.
La creazione della connessione e il commit/rollback sono nascosti all'interno di select ed exec.
Questo è buono, non voglio preoccuparmene nel mio codice "logico".

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) 

punti negativi:

• una nuova connessione viene sempre creato per ogni chiamata - Questo uccide le prestazioni su carichi pesanti
• DB url "users.db" è codificata - non posso riutilizzare queste funzioni attraverso altri progetti w/o modifica

DOMANDA 1: come introdurre un pool di connessioni wi un numero definito (minimo, massimo) di connessioni simultanee, quindi le connessioni verranno riutilizzate tra le chiamate select/exec?

DOMANDA 2: Come rendere configurabile la stringa "users.db"? (Come spostarlo sul codice cliente?)

Dovrebbe essere una funzione trasparente: il codice utente non dovrebbe richiedere la gestione/rilascio della connessione esplicita.

Answer 1

DOMANDA 2: Non ho mai usato HDBC, ma probabilmente scriverei qualcosa del genere.

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 

Aprire il Connection da qualche parte al di fuori della funzione, e non scollegarlo all'interno della funzione.

DOMANDA 1: Hmm, un pool di connessioni non sembra così difficile da implementare ...

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) 

Probabilmente non dovrebbe prendere questa parola per parola come ho nemmeno in fase di compilazione testato (e fail c'è abbastanza ostile), ma l'idea è di fare qualcosa di simile

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

e passare connPool intorno, se necessario.

Answer 2

Ho modificato il codice sopra, ora è in grado di compilare almeno.

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

Il pacchetto resource-pool fornisce un pool di risorse ad alte prestazioni che può essere utilizzato per il pool di connessione al database.Ad esempio:

import Data.Pool (createPool, withResource) 

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

Crea un pool di connessione al database con 1 sotto-pool e fino a 5 connessioni. Ogni connessione può essere inattiva per 10 secondi prima di essere distrutta.