From ca387b6455e062cb02ad3e1270c253726a292471 Mon Sep 17 00:00:00 2001
From: vrom911 <vrom911@gmail.com>
Date: Wed, 10 Jul 2019 20:09:02 +0800
Subject: [PATCH] [#8] Use Connection instead of Pool

Resolves #8
---
 postgresql-simple-named.cabal |  3 +--
 src/PgNamed.hs                | 18 ++++++++----------
 test/Spec.hs                  | 13 ++++++++-----
 3 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/postgresql-simple-named.cabal b/postgresql-simple-named.cabal
index b78296c..a621741 100644
--- a/postgresql-simple-named.cabal
+++ b/postgresql-simple-named.cabal
@@ -69,7 +69,6 @@ library
   build-depends:       bytestring ^>= 0.10.8
                      , mtl ^>= 2.2
                      , postgresql-simple ^>= 0.6.2
-                     , resource-pool ^>= 0.2.3.2
                      , text ^>= 1.2
 
 test-suite postgresql-simple-named-test
@@ -82,7 +81,7 @@ test-suite postgresql-simple-named-test
                      , hspec >= 2.6 && < 2.8
                      , postgresql-simple-named
                      , postgresql-simple
-                     , resource-pool
+                     , resource-pool ^>= 0.2.3.2
                      , transformers
 
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
diff --git a/src/PgNamed.hs b/src/PgNamed.hs
index f75b4b9..1514c5e 100644
--- a/src/PgNamed.hs
+++ b/src/PgNamed.hs
@@ -46,13 +46,11 @@ import Data.Char (isAlphaNum)
 import Data.Int (Int64)
 import Data.List (lookup)
 import Data.List.NonEmpty (NonEmpty (..), toList)
-import Data.Pool (Pool)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
 import GHC.Exts (IsString)
 
 import qualified Data.ByteString.Char8 as BS
-import qualified Data.Pool as Pool
 import qualified Database.PostgreSQL.Simple as PG
 import qualified Database.PostgreSQL.Simple.ToField as PG
 import qualified Database.PostgreSQL.Simple.Types as PG
@@ -171,7 +169,7 @@ n =? a = NamedParam n $ PG.toField a
 and expects a list of rows in return.
 
 @
-queryNamed dbPool [sql|
+queryNamed dbConnection [sql|
     SELECT id FROM table
     WHERE foo = ?foo
 |] [ "foo" '=?' "bar" ]
@@ -179,19 +177,19 @@ queryNamed dbPool [sql|
 -}
 queryNamed
     :: (MonadIO m, WithError m, PG.FromRow res)
-    => Pool PG.Connection  -- ^ Database connection pool
+    => PG.Connection  -- ^ Database connection
     -> PG.Query       -- ^ Query with named parameters inside
     -> [NamedParam]   -- ^ The list of named parameters to be used in the query
     -> m [res]        -- ^ Resulting rows
-queryNamed pool qNamed params =
+queryNamed conn qNamed params =
     withNamedArgs qNamed params >>= \(q, actions) ->
-        liftIO $ Pool.withResource pool (\conn -> PG.query conn q (toList actions))
+        liftIO $ PG.query conn q (toList actions)
 
 {- | Modifies the database with a given query and named parameters
 and expects a number of the rows affected.
 
 @
-executeNamed dbPool [sql|
+executeNamed dbConnection [sql|
     UPDATE table
     SET foo = 'bar'
     WHERE id = ?id
@@ -200,13 +198,13 @@ executeNamed dbPool [sql|
 -}
 executeNamed
     :: (MonadIO m, WithError m)
-    => Pool PG.Connection  -- ^ Database connection pool
+    => PG.Connection  -- ^ Database connection
     -> PG.Query       -- ^ Query with named parameters inside
     -> [NamedParam]   -- ^ The list of named parameters to be used in the query
     -> m Int64        -- ^ Number of the rows affected by the given query
-executeNamed pool qNamed params =
+executeNamed conn qNamed params =
     withNamedArgs qNamed params >>= \(q, actions) ->
-        liftIO $ Pool.withResource pool (\conn -> PG.execute conn q (toList actions))
+        liftIO $ PG.execute conn q (toList actions)
 
 -- | Helper to use named parameters.
 withNamedArgs
diff --git a/test/Spec.hs b/test/Spec.hs
index 7daa333..1aed37a 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -10,7 +10,7 @@ import GHC.Generics (Generic)
 import System.IO (hSetEncoding, stderr, stdout, utf8)
 import Test.Hspec (Spec, describe, hspec, it, shouldReturn)
 
-import PgNamed (PgNamedError (..), queryNamed, (=?))
+import PgNamed (NamedParam, PgNamedError (..), queryNamed, (=?))
 
 import qualified Data.Pool as Pool
 import qualified Database.PostgreSQL.Simple as Sql
@@ -38,20 +38,23 @@ unitTests dbPool = describe "Testing: postgresql-simple-named" $ do
         queryTestValue `shouldReturn` Right (TestValue 42 42 "baz")
   where
     missingNamedParam :: IO (Either PgNamedError TestValue)
-    missingNamedParam = runNamedQuery $ queryNamed dbPool "SELECT ?foo, ?bar" ["foo" =? True]
+    missingNamedParam = run "SELECT ?foo, ?bar" ["foo" =? True]
 
     noNamedParams :: IO (Either PgNamedError TestValue)
-    noNamedParams = runNamedQuery $ queryNamed dbPool "SELECT 42" []
+    noNamedParams = run "SELECT 42" []
 
     emptyName :: IO (Either PgNamedError TestValue)
-    emptyName = runNamedQuery $ queryNamed dbPool "SELECT ?foo, ?" ["foo" =? True]
+    emptyName = run "SELECT ?foo, ?" ["foo" =? True]
 
     queryTestValue :: IO (Either PgNamedError TestValue)
-    queryTestValue = runNamedQuery $ queryNamed dbPool "SELECT ?intVal, ?intVal, ?txtVal"
+    queryTestValue = run "SELECT ?intVal, ?intVal, ?txtVal"
         [ "intVal" =? (42 :: Int)
         , "txtVal" =? ("baz" :: ByteString)
         ]
 
+    run :: Sql.Query -> [NamedParam] -> IO (Either PgNamedError TestValue)
+    run q params = runNamedQuery $ Pool.withResource dbPool (\conn -> queryNamed conn q params)
+
 runNamedQuery :: ExceptT PgNamedError IO [TestValue] -> IO (Either PgNamedError TestValue)
 runNamedQuery = fmap (second head) . runExceptT