Better implementation of defaultGetDBRunner

This commit is contained in:
Michael Snoyman 2014-03-20 20:37:39 +02:00
parent aef99b44d8
commit 6ef507e54f
2 changed files with 19 additions and 22 deletions

View File

@ -25,8 +25,7 @@ import Control.Monad.Trans.Reader (runReaderT)
import Yesod.Core import Yesod.Core
import Data.Conduit import Data.Conduit
import Blaze.ByteString.Builder (Builder) import Blaze.ByteString.Builder (Builder)
import Data.IORef.Lifted import Data.Pool
import Data.Conduit.Pool
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Yesod.Core.Types (HandlerContents (HCError)) import Yesod.Core.Types (HandlerContents (HCError))
@ -82,24 +81,23 @@ defaultGetDBRunner :: YesodPersistBackend site ~ SqlPersistT
=> (site -> Pool SQL.Connection) => (site -> Pool SQL.Connection)
-> HandlerT site IO (DBRunner site, HandlerT site IO ()) -> HandlerT site IO (DBRunner site, HandlerT site IO ())
defaultGetDBRunner getPool = do defaultGetDBRunner getPool = do
ididSucceed <- newIORef False
pool <- fmap getPool getYesod pool <- fmap getPool getYesod
managedConn <- takeResource pool let withPrep conn f = f conn (SQL.connPrepare conn)
let conn = mrValue managedConn (relKey, (conn, local)) <- allocate
(do
(conn, local) <- takeResource pool
withPrep conn SQL.connBegin
return (conn, local)
)
(\(conn, local) -> do
withPrep conn SQL.connRollback
destroyResource pool local conn)
let withPrep f = f conn (SQL.connPrepare conn) let cleanup = liftIO $ do
(finishTransaction, ()) <- allocate (withPrep SQL.connBegin) $ \() -> do withPrep conn SQL.connCommit
didSucceed <- readIORef ididSucceed putResource local conn
withPrep $ if didSucceed _ <- unprotect relKey
then SQL.connCommit return ()
else SQL.connRollback
let cleanup = do
writeIORef ididSucceed True
release finishTransaction
mrReuse managedConn True
mrRelease managedConn
return (DBRunner $ \x -> runReaderT (unSqlPersistT x) conn, cleanup) return (DBRunner $ \x -> runReaderT (unSqlPersistT x) conn, cleanup)

View File

@ -1,5 +1,5 @@
name: yesod-persistent name: yesod-persistent
version: 1.2.2.1 version: 1.2.2.2
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -20,9 +20,8 @@ library
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2 && < 0.4
, blaze-builder , blaze-builder
, conduit , conduit
, lifted-base , resourcet >= 0.4.5
, pool-conduit , resource-pool
, resourcet
exposed-modules: Yesod.Persist exposed-modules: Yesod.Persist
Yesod.Persist.Core Yesod.Persist.Core
ghc-options: -Wall ghc-options: -Wall