Generalize defaultGetDBRunner

This commit is contained in:
Eric Easley 2016-04-10 13:04:48 -07:00
parent 329735e815
commit 8a9a78bd4c
2 changed files with 5 additions and 4 deletions

View File

@ -15,7 +15,7 @@ packages:
- ./yesod-websockets - ./yesod-websockets
- location: - location:
git: https://github.com/pseudonom/persistent.git git: https://github.com/pseudonom/persistent.git
commit: 0edba747e49c816e94c235bced16978cb729b175 commit: 1b7b70ed5d36adaffaf4cf9927fefcf16fec8969
subdirs: subdirs:
- persistent - persistent

View File

@ -1,3 +1,4 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -80,12 +81,12 @@ newtype DBRunner site = DBRunner
-- | Helper for implementing 'getDBRunner'. -- | Helper for implementing 'getDBRunner'.
-- --
-- Since 1.2.0 -- Since 1.2.0
defaultGetDBRunner :: YesodPersistBackend site ~ SQL.SqlBackend defaultGetDBRunner :: (SQL.IsSqlBackend backend, YesodPersistBackend site ~ backend)
=> (site -> Pool SQL.SqlBackend) => (site -> Pool backend)
-> HandlerT site IO (DBRunner site, HandlerT site IO ()) -> HandlerT site IO (DBRunner site, HandlerT site IO ())
defaultGetDBRunner getPool = do defaultGetDBRunner getPool = do
pool <- fmap getPool getYesod pool <- fmap getPool getYesod
let withPrep conn f = f conn (SQL.connPrepare conn) let withPrep conn f = f (persistBackend conn) (SQL.connPrepare $ persistBackend conn)
(relKey, (conn, local)) <- allocate (relKey, (conn, local)) <- allocate
(do (do
(conn, local) <- takeResource pool (conn, local) <- takeResource pool