{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Database.PostgreSQL.Tx.Simple
  ( PgSimpleEnv
  , PgSimpleM
  , module Database.PostgreSQL.Tx.Simple
  ) where

import Control.Exception (Exception)
import Data.Int (Int64)
import Database.PostgreSQL.Tx (TxM, shouldRetryTx)
import Database.PostgreSQL.Tx.Simple.Internal
import GHC.Stack (HasCallStack)
import qualified Database.PostgreSQL.Simple as Simple
import qualified Database.PostgreSQL.Simple.Transaction as Simple

-- | Analogue of 'Simple.withTransaction'.
--
-- @since 0.1.0.0
withTransaction
  :: (PgSimpleEnv r, HasCallStack)
  => r -> (HasCallStack => TxM r a) -> IO a
withTransaction :: r -> (HasCallStack => TxM r a) -> IO a
withTransaction = (Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
forall r a.
PgSimpleEnv r =>
(Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
unsafeRunTransaction Connection -> IO a -> IO a
forall a. Connection -> IO a -> IO a
Simple.withTransaction

-- | Analogue of 'Simple.withTransactionLevel'.
--
-- @since 0.1.0.0
withTransactionLevel
  :: (PgSimpleEnv r, HasCallStack)
  => Simple.IsolationLevel -> r -> (HasCallStack => TxM r a) -> IO a
withTransactionLevel :: IsolationLevel -> r -> (HasCallStack => TxM r a) -> IO a
withTransactionLevel = (Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
forall r a.
PgSimpleEnv r =>
(Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
unsafeRunTransaction ((Connection -> IO a -> IO a) -> r -> TxM r a -> IO a)
-> (IsolationLevel -> Connection -> IO a -> IO a)
-> IsolationLevel
-> r
-> TxM r a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsolationLevel -> Connection -> IO a -> IO a
forall a. IsolationLevel -> Connection -> IO a -> IO a
Simple.withTransactionLevel

-- | Analogue of 'Simple.withTransactionMode'.
--
-- @since 0.2.0.0
withTransactionMode
  :: (PgSimpleEnv r, HasCallStack)
  => Simple.TransactionMode -> r -> (HasCallStack => TxM r a) -> IO a
withTransactionMode :: TransactionMode -> r -> (HasCallStack => TxM r a) -> IO a
withTransactionMode = (Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
forall r a.
PgSimpleEnv r =>
(Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
unsafeRunTransaction ((Connection -> IO a -> IO a) -> r -> TxM r a -> IO a)
-> (TransactionMode -> Connection -> IO a -> IO a)
-> TransactionMode
-> r
-> TxM r a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionMode -> Connection -> IO a -> IO a
forall a. TransactionMode -> Connection -> IO a -> IO a
Simple.withTransactionMode

-- | Analogue of 'Simple.withTransactionSerializable'.
-- Unlike @postgresql-simple@, uses 'shouldRetryTx' to also retry
-- on @deadlock_detected@, not just @serialization_failure@.
--
-- Note that any 'IO' that occurs inside the 'TxM' may be executed multiple times.
--
-- @since 0.2.0.0
withTransactionSerializable
  :: (PgSimpleEnv r, HasCallStack)
  => r -> (HasCallStack => TxM r a) -> IO a
withTransactionSerializable :: r -> (HasCallStack => TxM r a) -> IO a
withTransactionSerializable =
  TransactionMode
-> (TxException -> Bool) -> r -> (HasCallStack => TxM r a) -> IO a
forall e r a.
(Exception e, PgSimpleEnv r, HasCallStack) =>
TransactionMode
-> (e -> Bool) -> r -> (HasCallStack => TxM r a) -> IO a
withTransactionModeRetry TransactionMode
mode TxException -> Bool
shouldRetryTx
  where
  mode :: TransactionMode
mode = IsolationLevel -> ReadWriteMode -> TransactionMode
Simple.TransactionMode IsolationLevel
Simple.Serializable ReadWriteMode
Simple.ReadWrite

-- | Analogue of 'Simple.withTransactionModeRetry'.
-- You should generally prefer 'withTransactionSerializable'.
--
-- Note that any 'IO' that occurs inside the 'TxM' may be executed multiple times.
--
-- @since 0.2.0.0
withTransactionModeRetry
  :: (Exception e, PgSimpleEnv r, HasCallStack)
  => Simple.TransactionMode -> (e -> Bool) -> r -> (HasCallStack => TxM r a) -> IO a
withTransactionModeRetry :: TransactionMode
-> (e -> Bool) -> r -> (HasCallStack => TxM r a) -> IO a
withTransactionModeRetry TransactionMode
mode e -> Bool
shouldRetry =
  (Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
forall r a.
PgSimpleEnv r =>
(Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
unsafeRunTransaction ((Connection -> IO a -> IO a) -> r -> TxM r a -> IO a)
-> (Connection -> IO a -> IO a) -> r -> TxM r a -> IO a
forall a b. (a -> b) -> a -> b
$ TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a
forall a e.
Exception e =>
TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a
Simple.withTransactionModeRetry' TransactionMode
mode e -> Bool
shouldRetry

-- | Analogue of 'Simple.query'
--
-- @since 0.1.0.0
query :: (Simple.ToRow q, Simple.FromRow x) => Simple.Query -> q -> PgSimpleM [x]
query :: Query -> q -> PgSimpleM [x]
query = (Connection -> Query -> q -> IO [x]) -> Query -> q -> PgSimpleM [x]
forall a1 a2 x.
(Connection -> a1 -> a2 -> IO x) -> a1 -> a2 -> PgSimpleM x
unsafeFromPgSimple2 Connection -> Query -> q -> IO [x]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
Simple.query

-- | Analogue of 'Simple.query_'.
--
-- @since 0.1.0.0
query_ :: (Simple.FromRow x) => Simple.Query -> PgSimpleM [x]
query_ :: Query -> PgSimpleM [x]
query_ = (Connection -> Query -> IO [x]) -> Query -> PgSimpleM [x]
forall a1 x. (Connection -> a1 -> IO x) -> a1 -> PgSimpleM x
unsafeFromPgSimple1 Connection -> Query -> IO [x]
forall r. FromRow r => Connection -> Query -> IO [r]
Simple.query_

-- | Analogue of 'Simple.execute'.
--
-- @since 0.1.0.0
execute :: (Simple.ToRow q) => Simple.Query -> q -> PgSimpleM Int64
execute :: Query -> q -> PgSimpleM Int64
execute = (Connection -> Query -> q -> IO Int64)
-> Query -> q -> PgSimpleM Int64
forall a1 a2 x.
(Connection -> a1 -> a2 -> IO x) -> a1 -> a2 -> PgSimpleM x
unsafeFromPgSimple2 Connection -> Query -> q -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
Simple.execute

-- | Analogue of 'Simple.execute_'.
--
-- @since 0.1.0.0
execute_ :: Simple.Query -> PgSimpleM Int64
execute_ :: Query -> PgSimpleM Int64
execute_ = (Connection -> Query -> IO Int64) -> Query -> PgSimpleM Int64
forall a1 x. (Connection -> a1 -> IO x) -> a1 -> PgSimpleM x
unsafeFromPgSimple1 Connection -> Query -> IO Int64
Simple.execute_