Merge branch 'pr/42'

library/Hasql/Commands.hs

@@ -29,5 +29,3 @@ setEncodersToUTF8 =
 setMinClientMessagesToWarning :: Commands
 setMinClientMessagesToWarning =
   Commands (pure "SET client_min_messages TO WARNING")
-
-

library/Hasql/Connection/Impl.hs

@@ -10,7 +10,7 @@ import qualified Hasql.IO as IO
 -- |
 -- A single connection to the database.
 data Connection =
-  Connection !LibPQ.Connection !Bool !PreparedStatementRegistry.PreparedStatementRegistry
+  Connection !(MVar LibPQ.Connection) !Bool !PreparedStatementRegistry.PreparedStatementRegistry
 
 -- |
 -- Possible details of the connection acquistion error.
@@ -21,17 +21,21 @@ type ConnectionError =
 -- Acquire a connection using the provided settings encoded according to the PostgreSQL format.
 acquire :: ByteString -> IO (Either ConnectionError Connection)
 acquire settings =
-  {-# SCC "acquire" #-} 
+  {-# SCC "acquire" #-}
   runEitherT $ do
     pqConnection <- lift (IO.acquireConnection settings)
     lift (IO.checkConnectionStatus pqConnection) >>= traverse left
     lift (IO.initConnection pqConnection)
     integerDatetimes <- lift (IO.getIntegerDatetimes pqConnection)
     registry <- lift (IO.acquirePreparedStatementRegistry)
-    pure (Connection pqConnection integerDatetimes registry)
+    pqConnectionRef <- lift (newMVar pqConnection)
+    pure (Connection pqConnectionRef integerDatetimes registry)
 
 -- |
 -- Release the connection.
 release :: Connection -> IO ()
-release (Connection pqConnection _ _) =
-  LibPQ.finish pqConnection
+release (Connection pqConnectionRef _ _) =
+  mask_ $ do
+    nullConnection <- LibPQ.newNullConnection
+    pqConnection <- swapMVar pqConnectionRef nullConnection
+    IO.releaseConnection pqConnection

library/Hasql/Query.hs

@@ -37,26 +37,26 @@ data ResultsError =
 -- |
 -- Decoder error details.
 data ResultError =
-  -- | 
+  -- |
   -- An error reported by the DB.
   -- Consists of the following: Code, message, details, hint.
-  -- 
+  --
   -- * __Code__.
   -- The SQLSTATE code for the error.
   -- It's recommended to use
   -- <http://hackage.haskell.org/package/postgresql-error-codes the "postgresql-error-codes" package>
   -- to work with those.
-  -- 
+  --
   -- * __Message__.
   -- The primary human-readable error message (typically one line). Always present.
-  -- 
+  --
   -- * __Details__.
-  -- An optional secondary error message carrying more detail about the problem. 
+  -- An optional secondary error message carrying more detail about the problem.
   -- Might run to multiple lines.
-  -- 
+  --
   -- * __Hint__.
-  -- An optional suggestion on what to do about the problem. 
-  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) 
+  -- An optional suggestion on what to do about the problem.
+  -- This is intended to differ from detail in that it offers advice (potentially inappropriate)
   -- rather than hard facts.
   -- Might run to multiple lines.
   ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |
@@ -90,23 +90,23 @@ data RowError =
 
 -- |
 -- A specification of a strictly single-statement query, which can be parameterized and prepared.
--- 
+--
 -- Consists of the following:
--- 
+--
 -- * SQL template,
 -- * params encoder,
 -- * result decoder,
 -- * a flag, determining whether it should be prepared.
--- 
+--
 -- The SQL template must be formatted according to Postgres' standard,
 -- with any non-ASCII characters of the template encoded using UTF-8.
 -- According to the format,
 -- parameters must be referred to using the positional notation, as in the following:
 -- @$1@, @$2@, @$3@ and etc.
 -- Those references must be used to refer to the values of the 'Encoders.Params' encoder.
--- 
+--
 -- Following is an example of the declaration of a prepared statement with its associated codecs.
--- 
+--
 -- @
 -- selectSum :: Hasql.'Hasql.Query' (Int64, Int64) Int64
 -- selectSum =
@@ -120,10 +120,10 @@ data RowError =
 --     decoder =
 --       Hasql.Decoders.'Hasql.Decoders.singleRow' (Hasql.Decoders.'Hasql.Decoders.value' Hasql.Decoders.'Hasql.Decoders.int8')
 -- @
--- 
+--
 -- The statement above accepts a product of two parameters of type 'Int64'
 -- and produces a single result of type 'Int64'.
--- 
+--
 data Query a b =
   Query !ByteString !(Encoders.Params a) !(Decoders.Result b) !Bool
   deriving (Functor)
@@ -142,11 +142,12 @@ instance Profunctor Query where
 -- |
 -- Execute the query, producing either a deserialization failure or a successful result.
 run :: Query a b -> a -> Connection.Connection -> IO (Either ResultsError b)
-run (Query template encoder decoder preparable) params (Connection.Connection pqConnection integerDatetimes registry) =
-  {-# SCC "query" #-} 
-  fmap (mapLeft coerceResultsError) $ runEitherT $ do
-    EitherT $ IO.sendParametricQuery pqConnection integerDatetimes registry template (coerceEncoder encoder) preparable params
-    EitherT $ IO.getResults pqConnection integerDatetimes (coerceDecoder decoder)
+run (Query template encoder decoder preparable) params (Connection.Connection pqConnectionRef integerDatetimes registry) =
+  {-# SCC "query" #-}
+  withMVar pqConnectionRef $ \pqConnection ->
+    fmap (mapLeft coerceResultsError) $ runEitherT $ do
+      EitherT $ IO.sendParametricQuery pqConnection integerDatetimes registry template (coerceEncoder encoder) preparable params
+      EitherT $ IO.getResults pqConnection integerDatetimes (coerceDecoder decoder)
 
 -- |
 -- WARNING: We need to take special care that the structure of