simple-postgresql-orm 0.7.0 → 0.8.0

raw patch · 2 files changed

+18/−10 lines, 2 filesdep +resource-pooldep ~simple

Dependencies added: resource-pool

Dependency ranges changed: simple

Files

• simple-postgresql-orm.cabal +5/−3
• src/Web/Simple/PostgreSQL.hs +13/−7

@@ -2,10 +2,11 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                simple-postgresql-orm-version:             0.7.0+version:             0.8.0 synopsis:            Connector package for integrating postgresql-orm with the Simple web framework description:            Connector package for integrating postgresql-orm with the Simple web framework homepage:            http://simple.cx+Bug-Reports:         http://github.com/alevy/simple/issues license:             LGPL-3 license-file:        LICENSE author:              Amit Aryeh Levy@@ -26,11 +27,12 @@     , filepath     , postgresql-simple     , postgresql-orm >= 0.2.2-    , simple >= 0.7.0 && < 0.8+    , resource-pool+    , simple >= 0.8.0 && < 0.9     , transformers   default-language:    Haskell2010  source-repository head   type: git-  location: anonymous@gitstar.com:alevy/simple.git+  location: http://github.com/alevy/simple.git 

@@ -4,21 +4,22 @@   , module Database.PostgreSQL.ORM   ) where -import Control.Concurrent.MVar import Control.Monad import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as S8+import Data.Pool import Database.PostgreSQL.ORM import Database.PostgreSQL.Devel import Database.PostgreSQL.Migrate import Database.PostgreSQL.Simple+import GHC.Conc (numCapabilities) import System.Directory import System.Environment import System.FilePath import System.IO import Web.Simple -type PostgreSQLConn = MVar Connection+type PostgreSQLConn = Pool Connection  class HasPostgreSQL hs where   postgreSQLConn :: hs -> PostgreSQLConn@@ -41,13 +42,18 @@     runMigrationsForDir stdout defaultMigrationsDir     putStrLn "Dev database started..."   let envConnect = maybe S8.empty S8.pack $ lookup "DATABASE_URL" env-  connectPostgreSQL envConnect >>= newMVar+  createPool (connectPostgreSQL envConnect) close numCapabilities 2 10  withConnection :: HasPostgreSQL hs                => (Connection -> Controller hs b) -> Controller hs b withConnection func = do-  dbvar <- postgreSQLConn `fmap` controllerState-  bracket (liftIO $ takeMVar dbvar) (liftIO . (putMVar dbvar)) $ \conn -> do-    res <- func conn-    return res+  pool <- postgreSQLConn `fmap` controllerState+  -- Stick the dbvar in an IORef so we can replace it if there is an+  -- exception. Always fill dbvar at the end, exception or otherwise.+  bracket (liftIO $ takeResource pool)+          (\(conn, lp) -> liftIO $ putResource lp conn) $+          funcE pool+        -- run the function, but on exceptions treat the connection as dead+  where funcE pool (conn, lp) = do+          (func conn) `onException` (liftIO $ destroyResource pool lp conn)