hasql-pool 0.5 → 0.5.0.1

raw patch · 4 files changed

+77/−7 lines, 4 filesdep +hasql-pooldep +hspecdep ~base-preludedep ~hasql

Dependencies added: hasql-pool, hspec

Dependency ranges changed: base-prelude, hasql

Files

• hasql-pool.cabal +20/−1
• library/Hasql/Pool.hs +7/−6
• library/Hasql/Pool/ResourcePool.hs +21/−0
• test/Main.hs +29/−0

@@ -1,7 +1,7 @@ name:   hasql-pool version:-  0.5+  0.5.0.1 category:   Hasql, Database, PostgreSQL synopsis:@@ -43,6 +43,7 @@     Haskell2010   other-modules:     Hasql.Pool.Prelude+    Hasql.Pool.ResourcePool   exposed-modules:     Hasql.Pool   build-depends:@@ -54,3 +55,21 @@     time >= 1.5 && < 2,     -- general:     base-prelude >= 1 && < 2+++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    base-prelude,+    hasql,+    hasql-pool,+    hspec >= 2.6 && < 3

@@ -12,13 +12,14 @@ import Hasql.Pool.Prelude import qualified Hasql.Connection import qualified Hasql.Session-import qualified Data.Pool+import qualified Data.Pool as ResourcePool+import qualified Hasql.Pool.ResourcePool as ResourcePool   -- | -- A pool of connections to DB. newtype Pool =-  Pool (Data.Pool.Pool (Either Hasql.Connection.ConnectionError Hasql.Connection.Connection))+  Pool (ResourcePool.Pool (Either Hasql.Connection.ConnectionError Hasql.Connection.Connection))  -- | -- Settings of the connection pool. Consist of:@@ -40,7 +41,7 @@ acquire :: Settings -> IO Pool acquire (size, timeout, connectionSettings) =   fmap Pool $-  Data.Pool.createPool acquire release stripes timeout size+  ResourcePool.createPool acquire release stripes timeout size   where     acquire =       Hasql.Connection.acquire connectionSettings@@ -53,7 +54,7 @@ -- Release the connection-pool. release :: Pool -> IO () release (Pool pool) =-  Data.Pool.destroyAllResources pool+  ResourcePool.destroyAllResources pool  -- | -- A union over the connection establishment error and the session error.@@ -68,6 +69,6 @@ use :: Pool -> Hasql.Session.Session a -> IO (Either UsageError a) use (Pool pool) session =   fmap (either (Left . ConnectionError) (either (Left . SessionError) Right)) $-  Data.Pool.withResource pool $-  traverse $ +  ResourcePool.withResourceOnEither pool $+  traverse $   Hasql.Session.run session

@@ -0,0 +1,21 @@+{-|+Extras for the resource-pool library.+-}+module Hasql.Pool.ResourcePool+where++import Hasql.Pool.Prelude+import Data.Pool+++withResourceOnEither :: Pool resource -> (resource -> IO (Either failure success)) -> IO (Either failure success)+withResourceOnEither pool act = mask_ $ do+  (resource, localPool) <- takeResource pool+  failureOrSuccess <- act resource+  case failureOrSuccess of+    Right success -> do+      putResource localPool resource+      return (Right success)+    Left failure -> do+      destroyResource pool localPool resource+      return (Left failure)

@@ -0,0 +1,29 @@+module Main where++import BasePrelude+import Test.Hspec+import Hasql.Pool+import qualified Hasql.Connection as Connection+import qualified Hasql.Decoders as Decoders+import qualified Hasql.Encoders as Encoders+import qualified Hasql.Session as Session+import qualified Hasql.Statement as Statement+++main = hspec $ do+  describe "Hasql.Pool.use" $ do+    it "releases a spot in the pool when there is an error" $ do+      pool <- acquire (1, 1, "host=localhost port=5432 user=postgres dbname=postgres")+      let+        statement = Statement.Statement "" Encoders.unit Decoders.unit True+        session = Session.statement () statement+        in do+          use pool session `shouldNotReturn` (Right ())+      let+        session = let+          statement = let+            decoder = Decoders.singleRow (Decoders.column Decoders.int8)+            in Statement.Statement "SELECT 1" Encoders.unit decoder True+          in Session.statement () statement+        in do+          use pool session `shouldReturn` (Right 1)