hasql/library/Hasql/Connection/Core.hs

51 lines
1.8 KiB
Haskell
Raw Normal View History

2015-12-21 16:45:10 +03:00
-- |
-- This module provides a low-level effectful API dealing with the connections to the database.
module Hasql.Connection.Core where
2015-12-21 16:45:10 +03:00
2024-04-19 07:38:30 +03:00
import Hasql.IO qualified as IO
2024-04-27 18:43:39 +03:00
import Hasql.LibPq14 qualified as LibPQ
import Hasql.Prelude
2024-04-19 07:38:30 +03:00
import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry
import Hasql.Settings qualified as Settings
2015-12-21 16:45:10 +03:00
-- |
-- A single connection to the database.
2022-06-20 13:54:54 +03:00
data Connection
= Connection !(MVar LibPQ.Connection) !Bool !PreparedStatementRegistry.PreparedStatementRegistry
2015-12-21 16:45:10 +03:00
-- |
-- Possible details of the connection acquistion error.
2015-12-23 14:23:39 +03:00
type ConnectionError =
2015-12-21 16:45:10 +03:00
Maybe ByteString
-- |
-- Acquire a connection using the provided settings encoded according to the PostgreSQL format.
2015-12-23 14:23:39 +03:00
acquire :: Settings.Settings -> IO (Either ConnectionError Connection)
2015-12-21 16:45:10 +03:00
acquire settings =
{-# SCC "acquire" #-}
2017-11-26 11:24:40 +03:00
runExceptT $ do
2015-12-21 16:45:10 +03:00
pqConnection <- lift (IO.acquireConnection settings)
2017-11-26 11:24:40 +03:00
lift (IO.checkConnectionStatus pqConnection) >>= traverse throwError
2015-12-21 16:45:10 +03:00
lift (IO.initConnection pqConnection)
integerDatetimes <- lift (IO.getIntegerDatetimes pqConnection)
registry <- lift (IO.acquirePreparedStatementRegistry)
pqConnectionRef <- lift (newMVar pqConnection)
pure (Connection pqConnectionRef integerDatetimes registry)
2015-12-21 16:45:10 +03:00
-- |
-- Release the connection.
release :: Connection -> IO ()
release (Connection pqConnectionRef _ _) =
mask_ $ do
nullConnection <- LibPQ.newNullConnection
pqConnection <- swapMVar pqConnectionRef nullConnection
IO.releaseConnection pqConnection
2016-07-23 15:44:55 +03:00
-- |
-- Execute an operation on the raw @libpq@ 'LibPQ.Connection'.
--
-- The access to the connection is exclusive.
withLibPQConnection :: Connection -> (LibPQ.Connection -> IO a) -> IO a
2016-07-23 15:44:55 +03:00
withLibPQConnection (Connection pqConnectionRef _ _) =
withMVar pqConnectionRef