I am a Java programmer who learns Haskell.
I work on a small web-app that uses Happstack and talks to a database via HDBC.
我是一名学习Haskell的Java程序员。我在一个小型网络应用程序上工作,该应用程序使用Happstack并通过HDBC与数据库进行通信。
I've written select and exec functions and I use them like this:
我编写了select和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
Very simple as you see. There is query, params and result.
Connection creation and commit/rollback stuff is hidden inside select and exec.
This is good, I don't want to care about it in my "logic" code.
你看,很简单。有查询,参数和结果。连接创建和提交/回滚内容隐藏在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)
Bad points:
- a new connection is always created for every call - this kills performance on heavy load
- DB url "users.db" is hardcoded - I can't reuse these functions across other projects w/o editing
始终为每个呼叫创建一个新连接 - 这会在重负载时导致性能下降
DB url“users.db”是硬编码的 - 我不能在没有编辑的情况下在其他项目中重用这些功能
QUESTION 1: how to introduce a pool of connections with some defined (min, max) number of concurrent connections, so the connections will be reused between select/exec calls?
问题1:如何引入具有一些已定义(最小,最大)并发连接数的连接池,以便在select / exec调用之间重用连接?
QUESTION 2: How to make "users.db" string configurable? (How to move it to client code?)
问题2:如何使“users.db”字符串可配置? (如何将其移动到客户端代码?)
It should be a transparent feature: user code should not require explicit connection handling/release.
它应该是一个透明的功能:用户代码不应该要求显式连接处理/释放。
3 个解决方案
#1
QUESTION 2: I've never used HDBC, but I'd probably write something like this.
问题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
Open the Connection
somewhere outside of the function, and don't disconnect it within the function.
在函数外部的某处打开Connection,并且不要在函数内断开它。
QUESTION 1: Hmm, a connection pool doesn't seem that hard to implement...
问题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)
You probably shouldn't take this verbatim as I haven't even compile-tested it (and fail
there is pretty unfriendly), but the idea is to do something like
你可能不应该逐字逐句,因为我甚至没有编译测试它(并且失败有相当不友好的),但想法是做类似的事情
connPool <- newConnPool 0 50 (connectSqlite3 "user.db") disconnect
and pass connPool
around as needed.
并根据需要传递connPool。
#2
The resource-pool package provides a high-performance resource pool which can be used for database connection pooling. For example:
资源池包提供了一个高性能资源池,可用于数据库连接池。例如:
import Data.Pool (createPool, withResource)
main = do
pool <- createPool newConn delConn 1 10 5
withResource pool $ \conn -> doSomething conn
Creates a database connection pool with 1 sub-pool and up to 5 connections. Each connection is allowed to be idle for 10 seconds before being destroyed.
创建一个包含1个子池和最多5个连接的数据库连接池。每个连接在被销毁之前都可以空闲10秒。
#3
I modified the code above, now it's able to compile at least.
我修改了上面的代码,现在它至少可以编译了。
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)
#1
QUESTION 2: I've never used HDBC, but I'd probably write something like this.
问题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
Open the Connection
somewhere outside of the function, and don't disconnect it within the function.
在函数外部的某处打开Connection,并且不要在函数内断开它。
QUESTION 1: Hmm, a connection pool doesn't seem that hard to implement...
问题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)
You probably shouldn't take this verbatim as I haven't even compile-tested it (and fail
there is pretty unfriendly), but the idea is to do something like
你可能不应该逐字逐句,因为我甚至没有编译测试它(并且失败有相当不友好的),但想法是做类似的事情
connPool <- newConnPool 0 50 (connectSqlite3 "user.db") disconnect
and pass connPool
around as needed.
并根据需要传递connPool。
#2
The resource-pool package provides a high-performance resource pool which can be used for database connection pooling. For example:
资源池包提供了一个高性能资源池,可用于数据库连接池。例如:
import Data.Pool (createPool, withResource)
main = do
pool <- createPool newConn delConn 1 10 5
withResource pool $ \conn -> doSomething conn
Creates a database connection pool with 1 sub-pool and up to 5 connections. Each connection is allowed to be idle for 10 seconds before being destroyed.
创建一个包含1个子池和最多5个连接的数据库连接池。每个连接在被销毁之前都可以空闲10秒。
#3
I modified the code above, now it's able to compile at least.
我修改了上面的代码,现在它至少可以编译了。
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)