Grupo de conexiones de bases de datos concurrentes en Haskell

Question

Soy un programador de Java que aprende Haskell.
Trabajo en una pequeña aplicación web que utiliza Happstack y habla con una base de datos a través de HDBC.

He escrito seleccione y ejecutivo funciones y los utilizo como esto:

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 

muy simple como se ve. Hay consulta, params y resultado.
La creación de la conexión y las tareas de compromiso/restitución están ocultas dentro de select y exec.
Esto es bueno, no me importa en mi código "lógico".

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) 

puntos negativos:

• una nueva conexión siempre se crea para cada llamada - Esto mata el rendimiento en carga pesada
• DB url "users.db" está codificado - No puedo reutilizar estas funciones a través de otros proyectos w/o editar

PREGUNTA 1: cómo introducir un grupo de conexiones wi ¿Alguna cantidad definida (mínima, máxima) de conexiones concurrentes, por lo que las conexiones se reutilizarán entre las llamadas select/exec?

PREGUNTA 2: ¿Cómo hacer que la cadena "users.db" se pueda configurar? (¿Cómo moverlo al código de cliente?)

Debe ser una función transparente: el código de usuario no debe requerir el manejo/liberación explícita de la conexión.

Answer 1

PREGUNTA 2: Nunca he usado HDBC, pero probablemente escribiría algo como esto.

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 

Abra la Connection en algún lugar fuera de la función, y no lo desconecte dentro de la función.

PREGUNTA 1: Hmm, una agrupación de conexiones no parece tan difícil de poner en práctica ...

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) 

Es probable que no debe tomar esta palabra por palabra como he ni siquiera compilación probado (y fail hay bastante desagradable), pero la idea es hacer algo como

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

y pasar alrededor connPool según sea necesario.

Answer 2

Modifiqué el código anterior, ahora es capaz de compilar al menos.

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

resource-pool El paquete proporciona un fondo de recursos de alto rendimiento que se puede utilizar para la agrupación de conexiones de base de datos.Por ejemplo:

import Data.Pool (createPool, withResource) 

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

Crea una agrupación de conexiones de base de datos con 1 sub-piscina y hasta 5 conexiones. Se permite que cada conexión permanezca inactiva durante 10 segundos antes de ser destruida.