Pula połączeń współbieżnych DB w Haskell

Question

Jestem programistą Java, który uczy się Haskell.
Pracuję w małej aplikacji internetowej, która używa Happstack i rozmawia z bazą danych za pośrednictwem HDBC.

Pisałem wybrać i Exec funkcje i wykorzystać je tak:

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 

Bardzo proste, jak widać. Istnieje zapytanie, params i wynik.
Tworzenie połączeń i zatwierdzanie/wycofywanie elementów są ukryte w select i exec.
To dobrze, nie chcę się tym przejmować w moim "logicznym" kodzie.

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) 

Minusy:

• nowe połączenie jest zawsze tworzone dla każdej rozmowy - to zabija wydajność na dużym obciążeniem
• DB url "users.db" jest ustalony - Nie mogę ponownego użycia tych funkcji na innych projektów w/o edycję

pytanie 1: jak wprowadzić pulę połączeń Wi jakąś określoną (min., maks.) liczbę współbieżnych połączeń, aby połączenia były ponownie wykorzystywane między wywołaniami select/exec?

PYTANIE 2: Jak skonfigurować ciąg "users.db"? (Jak przenieść go do kodu klienta?)

Powinna to być funkcja przezroczysta: kod użytkownika nie powinien wymagać jawnej obsługi/zwalniania połączenia.

Answer 1

PYTANIE 2: Nigdy nie stosowałem HDBC, ale prawdopodobnie napiszę coś takiego.

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 

Otwórz Connection gdzieś poza funkcją i nie odłączać go wewnątrz funkcji.

PYTANIE 1: Hmm, basen gra nie wydaje się trudne do realizacji ...

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) 

Prawdopodobnie nie powinni przyjmować tego verbatim jak ja nawet nie kompilacji przetestowane (i fail jest dość nieprzyjazny), ale chodzi o to, aby zrobić coś jak

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

i przekazać connPool dookoła, ile potrzeba.

Answer 2

Zmodyfikowałem powyższy kod, teraz jest on w stanie skompilować co najmniej.

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

Pakiet resource-pool zapewnia pulę zasobów wysokiej jakości, które mogą być używane do łączenia połączenia z bazą danych.Na przykład:

import Data.Pool (createPool, withResource) 

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

Tworzy pulę połączeń z bazą danych z 1 pulą podrzędną i maksymalnie 5 połączeniami. Każde połączenie może być bezczynne przez 10 sekund, zanim zostanie zniszczone.