Đồng thời kết nối DB pool trong Haskell

Question

Tôi là một lập trình viên Java học Haskell.
Tôi làm việc trên một ứng dụng web nhỏ sử dụng Happstack và trao đổi với cơ sở dữ liệu thông qua HDBC.

Tôi đã viết chọn và exec chức năng và tôi sử dụng chúng như thế này:

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 

Rất đơn giản như bạn thấy. Có truy vấn, thông số và kết quả.
Tạo kết nối và công cụ cam kết/cuộn lùi được ẩn bên trong chọn và thực thi.
Điều này là tốt, tôi không muốn quan tâm đến nó trong mã "logic" của tôi.

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) 

điểm xấu:

• một kết nối mới luôn tạo ra cho mỗi cuộc gọi - điều này giết chết hiệu suất trên tải nặng
• DB url "users.db" là hardcoded - Tôi không thể sử dụng lại các chức năng này trên các dự án khác bằng cách chỉnh sửa

CÂU HỎI 1: cách giới thiệu một nhóm kết nối wi th một số được xác định (min, max) số lượng kết nối đồng thời, do đó, các kết nối sẽ được tái sử dụng giữa các cuộc gọi select/exec?

CÂU HỎI 2: Cách đặt cấu hình chuỗi "users.db"? (Làm thế nào để chuyển nó sang mã máy khách?)

Nó phải là một tính năng trong suốt: mã người dùng không nên yêu cầu xử lý/giải phóng kết nối rõ ràng.

Answer 1

CÂU HỎI 2: Tôi chưa bao giờ sử dụng HDBC, nhưng tôi có thể viết một cái gì đó như thế này.

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 

Mở Connection ở đâu đó bên ngoài chức năng và không ngắt kết nối trong chức năng.

CÂU HỎI 1: Hmm, một hồ bơi kết nối dường như không quá khó để thực hiện ...

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) 

Bạn có lẽ không nên thực hiện việc này đúng nguyên văn như tôi đã thậm chí không biên dịch thử nghiệm nó (và fail có khá không thân thiện), nhưng ý tưởng là để làm một cái gì đó giống như

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

và vượt qua connPool xung quanh khi cần thiết.

Answer 2

Tôi đã sửa đổi mã ở trên, giờ đây nó có thể biên dịch ít nhất.

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

Gói resource-pool cung cấp hồ bơi tài nguyên hiệu suất cao có thể được sử dụng để kết nối cơ sở dữ liệu.Ví dụ:

import Data.Pool (createPool, withResource) 

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

Tạo hồ bơi kết nối cơ sở dữ liệu với 1 tiểu nhóm và tối đa 5 kết nối. Mỗi kết nối được cho phép không hoạt động trong 10 giây trước khi bị hủy.