module Hasql.Transaction.Sessions
(
  transaction,
  unpreparedTransaction,
  -- * Transaction settings
  C.Mode(..),
  C.IsolationLevel(..),
)
where

import Data.Bool
import qualified Hasql.Transaction.Private.Transaction as A
import qualified Hasql.Session as B
import qualified Hasql.Transaction.Private.Model as C


-- |
-- Execute the transaction using the provided isolation level and mode.
{-# INLINE transaction #-}
transaction :: C.IsolationLevel -> C.Mode -> A.Transaction a -> B.Session a
transaction :: IsolationLevel -> Mode -> Transaction a -> Session a
transaction IsolationLevel
isolation Mode
mode Transaction a
transaction =
  Transaction a -> IsolationLevel -> Mode -> Bool -> Session a
forall a.
Transaction a -> IsolationLevel -> Mode -> Bool -> Session a
A.run Transaction a
transaction IsolationLevel
isolation Mode
mode Bool
True

-- |
-- Execute the transaction using the provided isolation level and mode,
-- and specifying that the generated BEGIN, COMMIT and ABORT statements should not be prepared.
--
-- Helps with transaction pooling due to its incompatibility with prepared statements.
{-# INLINE unpreparedTransaction #-}
unpreparedTransaction :: C.IsolationLevel -> C.Mode -> A.Transaction a -> B.Session a
unpreparedTransaction :: IsolationLevel -> Mode -> Transaction a -> Session a
unpreparedTransaction IsolationLevel
isolation Mode
mode Transaction a
transaction =
  Transaction a -> IsolationLevel -> Mode -> Bool -> Session a
forall a.
Transaction a -> IsolationLevel -> Mode -> Bool -> Session a
A.run Transaction a
transaction IsolationLevel
isolation Mode
mode Bool
False