Add Connection type

lib/Database/PostgreSQL/Opium.hs

@@ -1,16 +1,19 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Database.PostgreSQL.Opium
+    -- * Connection Management
+  ( Connection
+  , connect
+  , close
     -- * Queries
     --
     -- Functions for performing queries. @fetch@ retrieves rows, @execute@ doesn't.
     -- The 'Connection' parameter comes last to facilitate currying for implicitly passing in the connection, e.g. from some framework's connection pool.
     --
     -- | TODO: Add @newtype Query = Query Text@ with @IsString@ instance to make constructing query strings at run time harder.
-  ( fetch
+  , fetch
   , fetch_
   , execute
   , execute_
@@ -28,18 +31,16 @@ module Database.PostgreSQL.Opium
 
 import Control.Monad (unless, void)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE)
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
 import Data.Functor.Identity (Identity (..))
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
-import Database.PostgreSQL.LibPQ
-  ( Connection
-  , Result
-  )
+import Database.PostgreSQL.LibPQ (Result)
 
 import qualified Data.Text.Encoding as Encoding
 import qualified Database.PostgreSQL.LibPQ as LibPQ
 
+import Database.PostgreSQL.Opium.Connection (Connection, connect, close, withRawConnection)
 import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
 import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..))
 import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable)
@@ -99,13 +100,20 @@ execParams
   -> ExceptT Error IO Result
 execParams conn query params = do
   let queryBytes = Encoding.encodeUtf8 query
-  liftIO (LibPQ.execParams conn queryBytes (toParamList params) LibPQ.Binary) >>= \case
-    Nothing ->
-      except $ Left ErrorNoResult
-    Just result -> do
-      status <- liftIO $ LibPQ.resultStatus result
-      mbMessage <- liftIO $ LibPQ.resultErrorMessage result
-      case mbMessage of
-        Just "" -> pure result
-        Nothing -> pure result
-        Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
+  -- Actually run the query while locking the connection.
+  mbResult <-
+    flip withRawConnection conn $ \mbRawConn -> do
+      rawConn <- mbRawConn `orThrow` ErrorConnectionClosed
+      liftIO $ LibPQ.execParams rawConn queryBytes (toParamList params) LibPQ.Binary
+  -- Check whether the result is valid or nah.
+  result <- mbResult `orThrow` ErrorNoResult
+  status <- liftIO $ LibPQ.resultStatus result
+  mbMessage <- liftIO $ LibPQ.resultErrorMessage result
+  case mbMessage of
+    Just "" -> pure result
+    Nothing -> pure result
+    Just message -> throwE $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
+
+  where
+    orThrow (Just x) _ = pure x
+    orThrow Nothing  e = throwE e

lib/Database/PostgreSQL/Opium/Connection.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Database.PostgreSQL.Opium.Connection
+  ( Connection
+  , unsafeWithRawConnection
+  , withRawConnection
+  , connect
+  , close
+  ) where
+
+import Data.ByteString (ByteString)
+import GHC.Stack (HasCallStack)
+
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+
+newtype Connection = Connection LibPQ.Connection
+
+withRawConnection
+  :: (Maybe LibPQ.Connection -> m a)
+  -> Connection
+  -> m a
+withRawConnection f (Connection rawConn) = f (Just rawConn)
+
+unsafeWithRawConnection
+  :: HasCallStack
+  => (LibPQ.Connection -> m a)
+  -> Connection
+  -> m a
+unsafeWithRawConnection f = withRawConnection $ \case
+  Nothing -> error "raw connection is missing! perhaps the connection was already closed."
+  Just rawConn -> f rawConn
+
+connect :: ByteString -> IO Connection
+connect connectionString = do
+  rawConn <- LibPQ.connectdb connectionString
+  pure $ Connection rawConn
+
+close :: Connection -> IO ()
+close (Connection rawConn) = LibPQ.finish rawConn

lib/Database/PostgreSQL/Opium/Error.hs

@@ -19,6 +19,7 @@ data Error
   | ErrorInvalidField ErrorPosition Oid ByteString String
   | ErrorNotExactlyOneRow
   | ErrorMoreThanOneRow
+  | ErrorConnectionClosed
   deriving (Eq, Show)
 
 instance Exception Error where