module Database.PostgreSQL.PQTypes.Transaction.Settings
  ( RestartPredicate (..)
  , TransactionSettings (..)
  , IsolationLevel (..)
  , Permissions (..)
  , defaultTransactionSettings
  ) where

import Control.Exception qualified as E

-- | Predicate that determines whether the transaction has to be restarted.
data RestartPredicate
  = forall e.
    E.Exception e =>
    RestartPredicate (e -> Integer -> Bool)

instance Show RestartPredicate where
  showsPrec :: Int -> RestartPredicate -> ShowS
showsPrec Int
_ RestartPredicate {} = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
"RestartPredicate"

data TransactionSettings = TransactionSettings
  { TransactionSettings -> Bool
tsAutoTransaction :: !Bool
  -- ^ If set to True, transaction will be automatically started at the
  -- beginning of database action and after each 'commit' / 'rollback'.  If
  -- set to False, no transaction will automatically start in either of above
  -- cases.
  , TransactionSettings -> IsolationLevel
tsIsolationLevel :: !IsolationLevel
  -- ^ Isolation level of all transactions.
  , TransactionSettings -> Maybe RestartPredicate
tsRestartPredicate :: !(Maybe RestartPredicate)
  -- ^ Defines behavior of 'withTransaction' in case exceptions thrown within
  -- supplied monadic action are not caught and reach its body.  If set to
  -- 'Nothing', exceptions will be propagated as usual. If set to 'Just' f,
  -- exceptions will be intercepted and passed to f along with a number that
  -- indicates how many times the transaction block already failed. If f
  -- returns 'True', the transaction is restarted. Otherwise the exception is
  -- further propagated. This allows for restarting transactions e.g. in case
  -- of serialization failure. It is up to the caller to ensure that is it
  -- safe to execute supplied monadic action multiple times.
  , TransactionSettings -> Permissions
tsPermissions :: !Permissions
  -- ^ Permissions of all transactions.
  }
  deriving (Int -> TransactionSettings -> ShowS
[TransactionSettings] -> ShowS
TransactionSettings -> String
(Int -> TransactionSettings -> ShowS)
-> (TransactionSettings -> String)
-> ([TransactionSettings] -> ShowS)
-> Show TransactionSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransactionSettings -> ShowS
showsPrec :: Int -> TransactionSettings -> ShowS
$cshow :: TransactionSettings -> String
show :: TransactionSettings -> String
$cshowList :: [TransactionSettings] -> ShowS
showList :: [TransactionSettings] -> ShowS
Show)

data IsolationLevel = DefaultLevel | ReadCommitted | RepeatableRead | Serializable
  deriving (IsolationLevel -> IsolationLevel -> Bool
(IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool) -> Eq IsolationLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsolationLevel -> IsolationLevel -> Bool
== :: IsolationLevel -> IsolationLevel -> Bool
$c/= :: IsolationLevel -> IsolationLevel -> Bool
/= :: IsolationLevel -> IsolationLevel -> Bool
Eq, Eq IsolationLevel
Eq IsolationLevel =>
(IsolationLevel -> IsolationLevel -> Ordering)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> Bool)
-> (IsolationLevel -> IsolationLevel -> IsolationLevel)
-> (IsolationLevel -> IsolationLevel -> IsolationLevel)
-> Ord IsolationLevel
IsolationLevel -> IsolationLevel -> Bool
IsolationLevel -> IsolationLevel -> Ordering
IsolationLevel -> IsolationLevel -> IsolationLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IsolationLevel -> IsolationLevel -> Ordering
compare :: IsolationLevel -> IsolationLevel -> Ordering
$c< :: IsolationLevel -> IsolationLevel -> Bool
< :: IsolationLevel -> IsolationLevel -> Bool
$c<= :: IsolationLevel -> IsolationLevel -> Bool
<= :: IsolationLevel -> IsolationLevel -> Bool
$c> :: IsolationLevel -> IsolationLevel -> Bool
> :: IsolationLevel -> IsolationLevel -> Bool
$c>= :: IsolationLevel -> IsolationLevel -> Bool
>= :: IsolationLevel -> IsolationLevel -> Bool
$cmax :: IsolationLevel -> IsolationLevel -> IsolationLevel
max :: IsolationLevel -> IsolationLevel -> IsolationLevel
$cmin :: IsolationLevel -> IsolationLevel -> IsolationLevel
min :: IsolationLevel -> IsolationLevel -> IsolationLevel
Ord, Int -> IsolationLevel -> ShowS
[IsolationLevel] -> ShowS
IsolationLevel -> String
(Int -> IsolationLevel -> ShowS)
-> (IsolationLevel -> String)
-> ([IsolationLevel] -> ShowS)
-> Show IsolationLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsolationLevel -> ShowS
showsPrec :: Int -> IsolationLevel -> ShowS
$cshow :: IsolationLevel -> String
show :: IsolationLevel -> String
$cshowList :: [IsolationLevel] -> ShowS
showList :: [IsolationLevel] -> ShowS
Show)

data Permissions = DefaultPermissions | ReadOnly | ReadWrite
  deriving (Permissions -> Permissions -> Bool
(Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool) -> Eq Permissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
/= :: Permissions -> Permissions -> Bool
Eq, Eq Permissions
Eq Permissions =>
(Permissions -> Permissions -> Ordering)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Permissions)
-> (Permissions -> Permissions -> Permissions)
-> Ord Permissions
Permissions -> Permissions -> Bool
Permissions -> Permissions -> Ordering
Permissions -> Permissions -> Permissions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Permissions -> Permissions -> Ordering
compare :: Permissions -> Permissions -> Ordering
$c< :: Permissions -> Permissions -> Bool
< :: Permissions -> Permissions -> Bool
$c<= :: Permissions -> Permissions -> Bool
<= :: Permissions -> Permissions -> Bool
$c> :: Permissions -> Permissions -> Bool
> :: Permissions -> Permissions -> Bool
$c>= :: Permissions -> Permissions -> Bool
>= :: Permissions -> Permissions -> Bool
$cmax :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
min :: Permissions -> Permissions -> Permissions
Ord, Int -> Permissions -> ShowS
[Permissions] -> ShowS
Permissions -> String
(Int -> Permissions -> ShowS)
-> (Permissions -> String)
-> ([Permissions] -> ShowS)
-> Show Permissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Permissions -> ShowS
showsPrec :: Int -> Permissions -> ShowS
$cshow :: Permissions -> String
show :: Permissions -> String
$cshowList :: [Permissions] -> ShowS
showList :: [Permissions] -> ShowS
Show)

-- | Default transaction settings.
defaultTransactionSettings :: TransactionSettings
defaultTransactionSettings :: TransactionSettings
defaultTransactionSettings =
  TransactionSettings
    { tsAutoTransaction :: Bool
tsAutoTransaction = Bool
True
    , tsIsolationLevel :: IsolationLevel
tsIsolationLevel = IsolationLevel
DefaultLevel
    , tsRestartPredicate :: Maybe RestartPredicate
tsRestartPredicate = Maybe RestartPredicate
forall a. Maybe a
Nothing
    , tsPermissions :: Permissions
tsPermissions = Permissions
DefaultPermissions
    }