Параллельный пул соединений DB в Haskell

Question

Я программист Java, который изучает Haskell.
Я работаю над небольшим веб-приложением, которое использует Happstack и разговаривает с базой данных через HDBC.

Я написал выбрать и EXEC функции, и я использую их, как это:

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 

Очень просто, как вы видите. Существует запрос, params и результат.
Создание соединения и фиксация/откат скрыты внутри select и exec.
Это хорошо, я не хочу заботиться об этом в своем «логическом» коде.

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) 

Плохие пункты:

• новое соединение всегда создается для каждого вызова - это убивает производительность на большой нагрузке
• DB URL "users.db" жестко закодировано - я не могу повторное использование этих функций через другие проекты без редактирования

Вопрос 1: как ввести пул соединений остроумия h определенное определенное (мин., макс.) количество одновременных соединений, поэтому соединения будут повторно использоваться между вызовами select/exec?

ВОПРОС 2: Как настроить строку «users.db»? (Как переместить его на клиентский код?)

Должна быть прозрачная функция: код пользователя не должен требовать явной обработки/освобождения подключения.

Answer 1

ВОПРОС 2: Я никогда не использовал HDBC, но, вероятно, я бы написал что-то вроде этого.

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 

Откройте Connection где-то за пределами функции, и не отключайте его внутри функции.

ВОПРОС 1: Хм, пул соединений не кажется, что трудно реализовать ...

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) 

Вы, вероятно, не следует принимать это дословно, как я даже не компиляции тестировал (и fail есть довольно недружелюбно), но идея состоит в том, чтобы сделать что-то вроде

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

и передать connPool вокруг по мере необходимости.

Answer 2

Я изменил код выше, теперь он может скомпилировать как минимум.

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 пакет предоставляет пул ресурсов высокой производительности, который может быть использован для подключения к базе данных объединения. Например:

import Data.Pool (createPool, withResource) 

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

Создает пул соединений с базой данных с одним под-пулом и до 5 подключений. Каждому соединению разрешено простаивать в течение 10 секунд перед уничтожением.