{-# LANGUAGE BlockArguments #-}
module Database.PostgreSQL.Tx.Squeal.Compat.Simple
  ( withSquealConnection
  ) where

import Database.PostgreSQL.Tx.Squeal.Internal (SquealConnection(UnsafeSquealConnection))
import qualified Control.Concurrent as Concurrent
import qualified Database.PostgreSQL.Simple as Simple
import qualified Database.PostgreSQL.Simple.Internal as Simple.Internal

-- | Used in the 'Database.PostgreSQL.Tx.Squeal.Internal.SquealEnv' to specify
-- the 'Database.PostgreSQL.Tx.Squeal.Internal.SquealConnection' from a
-- @postgresql-simple@ 'Simple.Connection'.
--
-- 'Database.PostgreSQL.Tx.Squeal.Internal.mkSquealConnection' should be
-- preferred over this function if you are only working with
-- @postgresql-libpq@ connections.
--
-- @since 0.1.0.0
withSquealConnection :: Simple.Connection -> (SquealConnection -> IO a) -> IO a
withSquealConnection :: Connection -> (SquealConnection -> IO a) -> IO a
withSquealConnection Connection
conn SquealConnection -> IO a
f = do
  SquealConnection -> IO a
f (SquealConnection -> IO a) -> SquealConnection -> IO a
forall a b. (a -> b) -> a -> b
$ IO Connection -> SquealConnection
UnsafeSquealConnection
    (IO Connection -> SquealConnection)
-> IO Connection -> SquealConnection
forall a b. (a -> b) -> a -> b
$ MVar Connection -> IO Connection
forall a. MVar a -> IO a
Concurrent.readMVar
    (MVar Connection -> IO Connection)
-> MVar Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ Connection -> MVar Connection
Simple.Internal.connectionHandle Connection
conn